如何继续循环下一行的每个单元格？

Question

如下所示，我有3张表，即：表“Shops Fruits Data”，表（“Months”）和表（“Output”）。

我正在尝试将数据从“Shops Fruits data”表中复制到（“Output”）结构中，该数据基于从表中的月份（“months”）。我已经写了一段代码。然而，使用这段代码，我只能遍历第一行。我不明白，我怎样才能继续到下一排，直到最后一排。其次，我也不能将商店和水果的名称复制到表单（“输出”）。

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

表格（“商店水果数据”）

工作表（“月”）

工作表（“输出”）

我正在尝试的代码：

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

Answer 1

根据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

Answer 2

这里有一个基本的定义：

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