Excel代码基于多个值和列复制行

Posted 2023-04-12

【中文标题】Excel代码基于多个值和列复制行

【英文标题】：Excel Code to duplicate rows based on multiple values and columns

【发布时间】：2021-01-14 10:36:22

【问题描述】：

我有每个月的销售数字的产品列表。我想创建一个新表，它根据月份复制值并将月份写在附加列中。

这是桌子

这就是我想要的结果

谢谢

【问题讨论】：

你能告诉我们一些你自己尝试过的东西吗？即使不能按您的意愿工作...

请尝试我的答案代码。但是下次你必须证明自己有兴趣自己寻找解决方案......

【参考方案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

【讨论】：

非常感谢，这个答案为我解决了。非常感谢

@MS：很高兴我能帮上忙！但是请注意，如果有其他问题，如果您不能证明自己参与解决问题，我将是第一个投票结束它...

我尝试过电源查询、unpivot 和其他东西。我的一个朋友建议寻找 VBA 代码。我通常只寻找答案，实际上我在这个网站上搜索了几天的类似案例。不幸的是找不到我要找的东西。很抱歉没有关注你的立场，这是我的第一个问题。下次会尽力而为。谢谢

@MS：这不是“类似情况”的问题。您应该根据自己的逻辑尝试一些事情。我使用了更快的版本，使用了两个数组，但是可以使用范围来解决问题。太......我的意思是，你必须以某种方式证明你自己尝试过一些东西。这就是社区精神。我们不会为需要它的人编写代码。我们只帮助他们了解错误并学习……我破例是为了提供帮助，但也动员您自己尝试。无论如何，有很多行在列上转置的情况。只有我回答了很多类似的问题。当然不一样。

下次我将分享我所做的所有步骤以及我在询问之前尝试的任何工作:) 谢谢