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

【问题标题】：How to continue the loop through each cell of Next Row?如何通过 Next Row 的每个单元格继续循环？
【发布时间】：2021-07-26 22:02:35
【问题描述】：

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

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

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

Sheets("Shops-Fruits Data")

	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1				2021	2021	2021	2021	2021	2021	2021	2021	2021	2021	2021	2021
2	Shop	Fruits	Quantity	JAN	FEB	MAR	APR	MAY	JUN	JUL	AUG	SEP	OCT	NOV	DEC
3	Walmart	Apple	Quantity	10	20	30	40	50	60	70	80	90	10	11	12
4	Walmart	Orange	Quantity	12	13	14	15	16	17	18	19	20	21	22	23
5	D-Mart	Apple	Quantity	36	38	40	42	44	46	48	50	52	54	56	58

表格（“月”）

	A
1	JAN
2	FEB
3	MAR
4	APR
5	MAY
6	JUN
7	JUL
8	AUG
9	SEP
10	OCT
11	NOV
12	DEC

表格（“输出”）

Shop	Fruits	Year	Month	Quantity
Walmart	Apple	2021	JAN	10
Walmart	Apple	2021	FEB	20
Walmart	Apple	2021	MAR	30
Walmart	Apple	2021	APR	40
Walmart	Apple	2021	MAY	50
Walmart	Apple	2021	JUN	60
Walmart	Apple	2021	JUL	70
Walmart	Apple	2021	AUG	80
Walmart	Apple	2021	SEP	90
Walmart	Apple	2021	OCT	10
Walmart	Apple	2021	NOV	11
Walmart	Apple	2021	DEC	12
Walmart	Orange	2021	JAN	12
Walmart	Orange	2021	FEB	13
Walmart	Orange	2021	MAR	14
Walmart	Orange	2021	APR	15
Walmart	Orange	2021	MAY	16
Walmart	Orange	2021	JUN	17
Walmart	Orange	2021	JUL	18
Walmart	Orange	2021	AUG	19
Walmart	Orange	2021	SEP	20
Walmart	Orange	2021	OCT	21
Walmart	Orange	2021	NOV	22
Walmart	Orange	2021	DEC	23
D-Mart	Apple	2021	JAN	36
D-Mart	Apple	2021	FEB	38
D-Mart	Apple	2021	MAR	40
D-Mart	Apple	2021	APR	42
D-Mart	Apple	2021	MAY	44
D-Mart	Apple	2021	JUN	46
D-Mart	Apple	2021	JUL	48
D-Mart	Apple	2021	AUG	50
D-Mart	Apple	2021	SEP	52
D-Mart	Apple	2021	OCT	54
D-Mart	Apple	2021	NOV	56
D-Mart	Apple	2021	DEC	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

【问题讨论】：

尚不清楚“月份”表的目的是什么。您的输出看起来像是“Shops-Fruits Data”的直接“depivot”
@Tim Williams The purpose of Months" Sheet 只是从 Shops-Fruits Data sheet 中找到相应月份的数据
您的数据表上有月份吗？
@Tim Williams Nah，我创建它只是为了在工作表 "Shops-Fruits Data" 中搜索月份。但是，我认为你有一个有效的观点，我看了两遍，它看起来像是工作表 "Shops-Fruits Data" 的 "Unpivot" 。然后，我录制了一个宏，我得到了我想要的！只有一年我会手动过去！不过感谢您的提示！最好的祝福！ :)

标签： excel vba

【解决方案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

【讨论】：

太完美了！非常感谢！玩得开心！ :)

【解决方案2】：

根据 Tim Williams 提出的观点，这里是反透视数据的代码。

Sub test()
    
    
        Sheets("Shops-Fruits Data").Range("Table10").Select
        ActiveWorkbook.Queries.Add Name:="Query", Formula:= _
            "let" & Chr(13) & "" & Chr(10) & "    Source = Excel.CurrentWorkbook(){[Name=""Table10""]}[Content]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Source,{{""Shop"", type text}, {""Fruits"", type text}, {""Quantity"", type text}, {""JAN"", Int64.Type}, {""FEB"", Int64.Type}, {""MAR"", Int64.Type}, {""APR"", Int64.Type}, {""MAY"", Int64.Type}, {""JUN"", Int64.Type}, {""JUL"", Int64.Type}, " & _
            "{""AUG"", Int64.Type}, {""SEP"", Int64.Type}, {""OCT"", Int64.Type}, {""NOV"", Int64.Type}, {""DEC"", Int64.Type}})," & Chr(13) & "" & Chr(10) & "    #""Unpivoted Other Columns"" = Table.UnpivotOtherColumns(#""Changed Type"", {""Shop"", ""Fruits"", ""Quantity""}, ""Attribute"", ""Value"")" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Unpivoted Other Columns"""
    
        With Sheets("Output").ListObjects.Add(SourceType:=0, Source:= _
            "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Query"";Extended Properties=""""" _
            , Destination:=Sheets("Output").Range("$A$1")).QueryTable
            .CommandType = xlCmdSql
            .CommandText = Array("SELECT * FROM [Query]")
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = True
            .ListObject.DisplayName = "Table_10"
            .Refresh BackgroundQuery:=False
        End With
        Range("F2").Select
    End Sub

【讨论】：