Excel 根据多个值和列复制行的代码

Question

我有每个月的销售数量的产品列表。我想创建新的 table 来复制基于月份的值，并将月份写在附加列中。

这是table

这就是我想要的结果

谢谢

Answer 1

请尝试下一个代码：

Sub testTransposePerMonth()
 Dim sh As Worksheet, sh1 As Worksheet, lastR As Long, arr, arrF
 Dim i As Long, k As Long, j As Long, n As Long, maxF As Long

 Set sh = ActiveSheet
 Set sh1 = sh.Next 'use here the sheet you need
 
 lastR = sh.Range("A" & rows.count).End(xlUp).row 'last row of the existing sheet
 arr = sh.Range("A1:O" & lastR).Value             'put the range in an array
 maxF = WorksheetFunction.Sum(sh.Range("D2:O" & lastR)) + 1 'calculate the arrF rows No

 ReDim arrF(1 To maxF, 1 To 4)                    'Redim the final array
 arrF(1, 1) = "Product Number": arrF(1, 2) = "City"
 arrF(1, 3) = "Region": arrF(1, 4) = "Month"      'Put headers in the array
 k = 2
 For i = 2 To UBound(arr)       'iterate between all the array elements
    For j = 4 To UBound(arr, 2) 'iterate between the array cols, starting from the fourth
        If arr(i, j) <> "" Then 'if it is a value on the row
            For n = 1 To CLng(arr(i, j)) 'add so many rows as the number means
                arrF(k, 1) = arr(i, 1): arrF(k, 2) = arr(i, 2)
                arrF(k, 3) = arr(i, 3): arrF(k, 4) = arr(1, j): k = k + 1 'iterate k
            Next
        End If
    Next j
 Next i
 'drop the processed array at once:
 sh1.Range("A1").Resize(UBound(arrF), 4).Value = arrF
End Sub

Excel 根据多个值和列复制行的代码

Excel Code to duplicate rows based on multiple values and columns

excel

vba

unpivot

powerquery