添加行并重复设置数据多次 [英] Add lines and duplicate data a set number of times

问题描述

我正在尝试编写一个VBA Excel宏以遍历数十万行数据，以确保A列中的每个唯一条目都具有与C列相等的条目.

I am trying to write a VBA Excel Macro to look through hundreds of thousands of lines of data to make sure that each unique entry in column A has a number of entries equal to column C.

例如:

源帐户ID 84512发生了6次，但必须出现12次(如C列所示).这意味着我需要在现有的6行之前(或之后)添加6行.

Source Account Id 84512 occurs 6 times but there needs to be 12 occurrences (as indicated by column C). This means I need to add 6 lines, before (or after) the existing 6 lines.

接下来，我们看到源帐户ID 64857发生一次，但需要发生5次.我将在上面添加4行，并使用相同的源帐户ID代码和相同的帐户名称.其余单元格可以为"0".

Next we see Source Account Id 64857 occurs once but needs to occur 5 times. I would add 4 lines above and have the same Source Account Id code and the same Account Name. The rest of the cells can be "0".

以下是成品的一个示例:

Here is an example of the finished product:

这是我到目前为止所拥有的:

Here is what I have so far:

Sub InsertRowAtChangeInValue()
   Dim lRow As Long
   Dim nMonths As Long
   
   For lRow = Cells(Cells.Rows.count, "A").End(xlUp).Row To 2 Step -1
    nMonths = 12 - Cells(Application.ActiveCell.Row, 3).Value
      If Cells(lRow, "A") <> Cells(lRow - 1, "A") Then Rows(lRow).EntireRow.Resize(nMonths).Insert
   Next lRow
End Sub

如果您有任何建议，请告诉我.

Please let me know if you have any suggestions.

*这些示例中的所有数据都是虚构的

*All data in these examples is fictional

推荐答案

重命名引用的工作表后，请尝试执行此操作.

Try this after renaming the referenced worksheet.

Sub expandMonths()
    'https://stackoverflow.com/questions/52304181
    Dim i As Long, j As Long, m As Long, a As Variant

    With Worksheets("sheet1")

        i = .Cells(.Rows.Count, "A").End(xlUp).Row
        Do While i > 1
            a = Array(.Cells(i, "A").Value2, .Cells(i, "B").Value2, 0, 0, 0, 0)
            m = .Cells(i, "C").Value2
            j = Application.Match(.Cells(i, "A").Value2, .Columns("A"), 0)

            If i - j < m Then
                .Rows(j).Resize(m - (i - j) - 1, 1).EntireRow.Insert
                .Cells(j, "A").Resize(m - (i - j) - 1, UBound(a) + 1) = a
                .Cells(j, "C").Resize(m - (i - j) - 1, 4).NumberFormat = "0"
            End If

            i = j - 1
        Loop
    End With

End Sub

这篇关于添加行并重复设置数据多次的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！