Question

我现有的脚本可以完成我需要的大部分工作。脚本（从此处：https://www.extendoffice.com/documents/excel/4054-excel-duplicate-rows-based-on-cell-value.html）基本上插入并复制X数据行X次，其中X是表中的字段之一。它运作良好，参考页显示了起点和终点的示例。

但是当我在Excel中运行脚本时，我从表中的〜2,000行增加到了〜40,000行。我需要修改所有重复的行（增量日期），因此我现在打算在脚本运行时也将新数据包含到表中，这将允许我更改重复的行中的数据……例如，我可以使用重复数字1、2、3、4和一些简单的公式来更改相对于起点的日期。

我希望我需要在例程中插入一些其他代码，这些代码会将数据添加到指定的列并从1开始自动递增。

由于VBA实际技能为零，因此我不知道如何使用已有的代码解决问题的第二部分。任何帮助都将非常棒！

Sub CopyData()
'Updateby Extendoffice 20160922
    Dim xRow As Long
    Dim VInSertNum As Variant
    xRow = 1
    Application.ScreenUpdating = False
    Do While (Cells(xRow, "A") <> "")
        VInSertNum = Cells(xRow, "D")
        If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
           Range(Cells(xRow, "A"), Cells(xRow, "D")).Copy
           Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "D")).Select
           Selection.Insert Shift:=xlDown
           xRow = xRow + VInSertNum - 1
        End If
        xRow = xRow + 1
    Loop
    Application.ScreenUpdating = False
End Sub

Answer 1

在下面尝试此代码，我在您提供的链接上使用了相同的示例数据。但是在此代码上，我创建了2个工作表，一个工作表用于处理原始数据，一个工作表用于重复输出，包括日期和重复数的增量。

Sub duplicateData()

Dim rSH As Worksheet
Set rSH = ThisWorkbook.Sheets("RAW") 'Your raw data
Dim oSH As Worksheet
Set oSH = ThisWorkbook.Sheets("OUTPUT") 'Output data on another sheet

x = 2
For a = 2 To rSH.Range("A" & Rows.Count).End(xlUp).Row
    For b = 1 To rSH.Cells(a, 4).Value '4 is the column of duplicate times
        If b = 1 Then
            For c = 1 To 4 'Number of your column
                oSH.Cells(x, c).Value = rSH.Cells(a, c).Value
            Next c
            oSH.Cells(x, 5) = 1 'First instance, 5 is the column number of duplicate counter
        Else
            For c = 1 To 4 'Number of your column
                oSH.Cells(x, c).Value = rSH.Cells(a, c).Value
            Next c
            oSH.Cells(x, 3).Value = CDate(oSH.Cells(x - 1, 3).Value) + 1 '3 is the column number of date to increment
            oSH.Cells(x, 5).Value = CInt(oSH.Cells(x - 1, 5).Value) + 1 '5 is the column number of duplicate counter
        End If
        x = x + 1 'Increment Output row number
    Next b
Next a
End Sub

VBA自动将行号增加到Excel中的新列中

1 个答案: