excel - 如何通过 Next Row 的每个单元格继续循环？

Question

如下所示，我有 3 张工作表，即：工作表“Shops-Fruits Data”、工作表（“月份”）和工作表（“输出”）。

我正在尝试根据从工作表（“月份”）到（“输出”）结构的月份从工作表“商店 - 水果数据”中复制数据。我已经写了一个代码。但是，使用此代码，我只能遍历第一行。我不明白，我如何继续下一行直到最后一行。其次，我也无法将商店和水果名称复制到工作表（“输出”）。

我已经在工作表输出表中手动复制了所需的结果，如下所示，您可以在那里看到我想要实现的目标。如果有人能带领我，那就太好了！谢谢你。

Sheets("商店-水果数据")

	一个	乙	C	D	乙	F	G	H	我	Ĵ	ķ	大号	米	ñ	○
1				2021	2021	2021	2021	2021	2021	2021	2021	2021	2021	2021	2021
2	店铺	水果	数量	一月	二月	三月	年利率	可能	君	七月	八月	九月	华侨城	十一月	十二月
3	沃尔玛	苹果	数量	10	20	30	40	50	60	70	80	90	10	11	12
4	沃尔玛	橙子	数量	12	13	14	15	16	17	18	19	20	21	22	23
5	D-Mart	苹果	数量	36	38	40	42	44	46	48	50	52	54	56	58

表（“月”）

	一个
1	一月
2	二月
3	三月
4	年利率
5	可能
6	君
7	七月
8	八月
9	九月
10	华侨城
11	十一月
12	十二月

工作表（“输出”）

店铺	水果	年	月	数量
沃尔玛	苹果	2021	一月	10
沃尔玛	苹果	2021	二月	20
沃尔玛	苹果	2021	三月	30
沃尔玛	苹果	2021	年利率	40
沃尔玛	苹果	2021	可能	50
沃尔玛	苹果	2021	君	60
沃尔玛	苹果	2021	七月	70
沃尔玛	苹果	2021	八月	80
沃尔玛	苹果	2021	九月	90
沃尔玛	苹果	2021	华侨城	10
沃尔玛	苹果	2021	十一月	11
沃尔玛	苹果	2021	十二月	12
沃尔玛	橙子	2021	一月	12
沃尔玛	橙子	2021	二月	13
沃尔玛	橙子	2021	三月	14
沃尔玛	橙子	2021	年利率	15
沃尔玛	橙子	2021	可能	16
沃尔玛	橙子	2021	君	17
沃尔玛	橙子	2021	七月	18
沃尔玛	橙子	2021	八月	19
沃尔玛	橙子	2021	九月	20
沃尔玛	橙子	2021	华侨城	21
沃尔玛	橙子	2021	十一月	22
沃尔玛	橙子	2021	十二月	23
D-Mart	苹果	2021	一月	36
D-Mart	苹果	2021	二月	38
D-Mart	苹果	2021	三月	40
D-Mart	苹果	2021	年利率	42
D-Mart	苹果	2021	可能	44
D-Mart	苹果	2021	君	46
D-Mart	苹果	2021	七月	48
D-Mart	苹果	2021	八月	50
D-Mart	苹果	2021	九月	52
D-Mart	苹果	2021	华侨城	54
D-Mart	苹果	2021	十一月	56
D-Mart	苹果	2021	十二月	58

我正在尝试的代码：

Sub test()

Dim c As Range, d As Range, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, LastRow As Long
Dim Mon As String


Set ws1 = Sheets("Shops-Fruits Data")
Set ws2 = Sheets("Months")
Set ws3 = Sheets("Output")

LastRow = ws2.Cells(Rows.Count, 1).End(xlUp).Row
i = 2
For Each c In ws2.Range("A1:A" & LastRow)
    Mon = c.Value

    With ws1.Range("D2:O2")
        Set d = .Find(Mon, , LookIn:=xlValues)
    With ws3.Range("D:D")
          'Copy Months
          .Cells(i, 1) = c.Value
          'Copy Year
          .Cells(i, 0) = d.Offset(-1, 0).Value
          'Copy Quantity
          .Cells(i, 2) = d.Offset(1, 0).Value
          'Copy Fruit Name till December.
          .Cells(2, -1) = d.Offset(1, -1).Value 'But it fails!
          'Copy Shop Name till December.
          .Cells(2, -2) = d.Offset(1, -2).Value 'But it fails!
            i = i + 1
           'How do I continue to next row now?
    End With
    End With
    Next c
End Sub

标签： excelvba

Answer 1

这是一个基本的转折点：

Sub Depivot()
    
    Dim arr, arrOut, r As Long, c As Long, rOut As Long
    
    arr = Worksheets("Data").Range("a1").CurrentRegion.Value   'input data to array
    ReDim arrOut(1 To UBound(arr, 1) * UBound(arr, 2), 1 To 5) 'resize output array (approx. size)
    'loop input array
    For r = 3 To UBound(arr, 1)
        For c = 4 To UBound(arr, 2)
            rOut = rOut + 1
            arrOut(rOut, 1) = arr(r, 1)
            arrOut(rOut, 2) = arr(r, 2)
            arrOut(rOut, 3) = arr(1, c)
            arrOut(rOut, 4) = arr(2, c)
            arrOut(rOut, 5) = arr(r, c)
        Next c
    Next r
    'place the output on a sheet
    Worksheets("Depivot").Range("A1").Resize(rOut, 5).Value = arrOut

End Sub