Question

我有一个包含272个区域的工作表（表1）（D4列：D275），每行有11个类别（类别名称E3：O3）（见图1）：

http://i.stack.imgur.com/mFnaf.png

我需要重新排列这些数据（在表2中），以便每个类别都有自己的行（即总共272 * 11行）。（见图2）：

http://i.stack.imgur.com/wvfXS.png

我知道这需要hlookup，但我不知道如何为它编写VBA代码。请有人告诉我我需要的代码是什么，并解释每个步骤的作用，因为我将在许多不同的文档上执行此操作，因此需要知道如何调整代码。

如果需要更多信息，请告诉我

非常感谢！

Answer 1

根据附带的截图，这将完成分别在A，B和C列中添加值的工作

Count = 4

For i = 4 To 18
    For j = 5 To 15
        Cells(Count, 1).Value = Cells(i, 4).Value
        Cells(Count, 2).Value = Cells(i, j).Value
        Cells(Count, 3).Value = Cells(3, j).Value
        Count = Count + 1
    Next j
Next i

Answer 2

如果你知道你应该在屏幕上使用的公式，可以使用Application.WorksheetFunction通过VBA宏代码使用相同的forumla

=VLOOKUP(XXXX)

可以用宏写成

Application.WorksheetFunction.VLookup(XXXX)

希望这有帮助。

Answer 3

尝试下面的内容。请改变

Sub test()
    Dim r As Range
    Dim incre As Long
    Dim distr As String
    Set r = Range("D4:K6")
    incre = 4
    incre2 = 4
    For Each cell In r
        If cell Like "District*" Then
            distr = cell.Value
        Else
            Range("B" & incre).Value = cell.Value
            Range("A" & incre).Value = distr
            incre = incre + 1
        End If
    Next
End Sub

Answer 4

嗯，有很多方法可以实现你想要实现的目标。

<强> 1。使用公式

在A4的单元格Sheet2中输入以下公式并根据需要拖放/复制

=OFFSET(Sheet1!$D$4,FLOOR((ROW(Sheet1!D4)-ROW(Sheet1!$D$4))/11,1),0)

在C4的单元格Sheet2中输入以下公式并根据需要拖放/复制

=OFFSET(Sheet1!$E$4,FLOOR((ROW(Sheet1!E4)-ROW(Sheet1!$E$4))/11,1),MOD(ROW(Sheet1!D4)-ROW(Sheet1!$D$4),11))

<强> 2。使用VBA

方法I - 从Sheet1计算值并更新Sheet2

中的范围

Sub Demo1()
    Dim srcWB As Workbook
    Dim srcWS As Worksheet, destWS As Worksheet
    Dim lastRow As Long, lastCol As Long, i As Long, CategoryCnt As Long, temp

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set srcWB = ThisWorkbook
    Set srcWS = srcWB.Sheets("Sheet1")
    Set destWS = srcWB.Sheets("Sheet2")
    CategoryCnt = 11    '->enter number of categories
    lastRow = srcWS.Cells(Rows.Count, "D").End(xlUp).Row    '->last row with data
    lastCol = srcWS.Cells(3, Columns.Count).End(xlToLeft).Column    '->last column with data

    For i = 4 To (lastRow - 4) * CategoryCnt
        destWS.Cells(i, 1) = srcWS.Cells(Int((i - 4) / CategoryCnt) + 4, 4)
        destWS.Cells(i, 3) = srcWS.Cells(Int((i - 4) / CategoryCnt) + 4, ((i - 4) Mod CategoryCnt) + 5)
    Next i

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

方法II - 在Sheet2范围

中输入公式

Sub Demo2()
    Dim srcWB As Workbook
    Dim srcWS As Worksheet, destWS As Worksheet
    Dim lastRow As Long, lastCol As Long, i As Long, CategoryCnt As Long, temp

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set srcWB = ThisWorkbook
    Set srcWS = srcWB.Sheets("Sheet1")
    Set destWS = srcWB.Sheets("Sheet2")
    CategoryCnt = 11
    lastRow = srcWS.Cells(Rows.Count, "D").End(xlUp).Row
    lastCol = srcWS.Cells(3, Columns.Count).End(xlToLeft).Column

    destWS.Range("A4").Formula = "=OFFSET(Sheet1!$D$4,FLOOR((ROW(Sheet1!D4)-ROW(Sheet1!$D$4))/11,1),0)"
    destWS.Range("C4") = "=OFFSET(Sheet1!$E$4,FLOOR((ROW(Sheet1!E4)-ROW(Sheet1!$E$4))/11,1),MOD(ROW(Sheet1!D4)-ROW(Sheet1!$D$4),11))"
    Range("A4:C4").Select
    Selection.AutoFill Destination:=destWS.Range("A4:C" & (lastRow - 4) * 11), Type:=xlFillDefault

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

如果有什么不清楚，请告诉我。

见图片参考：

<强> Sheet 1中

<强> Sheet 2中

如何从一个工作表查找到另一个工作表并重复多行

4 个答案: