添加行并重复设置数据多次

本文介绍了添加行并重复设置数据多次的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述

我正在尝试编写一个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() 'stackoverflow/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