Question

我的代码会根据2个数字之间缺失的数据插入行数，但我无法找出代码来复制和粘贴我缺少的年份。

在此先感谢您提供任何帮助，我非常擅长操作现有代码，但我无法找到任何可添加到其中的代码以使其正常工作

以下是我必须插入正确数量的空行

的代码

Public Sub Insert()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual   'pre XL97 xlManual

lastRow = ActiveSheet.UsedRange.Rows.Count
ActiveSheet.Cells(lastRow, 1).Select

Set CurrentCell = ActiveSheet.Cells(lastRow, 1)

For n = lastRow To 0 Step -1
    If n = lastRow Then GoTo CheckLastRow
    If n = 1 Then GoTo CheckfirstRow
        ActiveCell.Offset(-2, 0).Select
        CheckLastRow:
    Set NextCell = CurrentCell.Offset(-1, 0)

        ActiveCell.Offset(1, 0).Select
        For i = 1 To CurrentCell
            ActiveCell.EntireRow.Insert
        Next i

    Set CurrentCell = NextCell
Next n

'To be performed on the firstrow in the column
CheckfirstRow:
        ActiveCell.Offset(-1, 0).Select
        For i = 1 To CurrentCell
            ActiveCell.EntireRow.Insert
        Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

我的数据看起来像这样

A列是我需要的行数B和C列有多年 B = 2009 C = 2013

需要输出复制该行，看起来像

2009 2010

2010 2011

2011 2012

2012 2013

我将此添加到代码中，但我仍然只有空行

Public Sub InsertTest()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual   'pre XL97 xlManual

lastRow = ActiveSheet.UsedRange.Rows.Count
ActiveSheet.Cells(lastRow, 1).Select

Set CurrentCell = ActiveSheet.Cells(lastRow, 1)

For n = lastRow To 0 Step -1
    If n = lastRow Then GoTo CheckLastRow
    If n = 1 Then GoTo CheckfirstRow
        ActiveCell.Offset(-2, 0).Select

CheckLastRow:
    Set NextCell = CurrentCell.Offset(-1, 0)

        ActiveCell.Offset(1, 0).Select
        For i = 1 To CurrentCell
            ActiveCell.EntireRow.Insert
        Next i
    With Worksheets("Sheet1")
newYear = .Cells(n, 2).Value
YearDifference = .Cells(n, 3).Value - newYear
For j = 0 To YearDifference - 1
    .Cells(n + j, 2).Value = newYear
    newYear = newYear + 1
    .Cells(n + j, 3).Value = newYear
Next j
End With
    Set CurrentCell = NextCell
Next n

'To be performed on the firstrow in the column
CheckfirstRow:
        ActiveCell.Offset(-1, 0).Select
        For i = 1 To CurrentCell
            ActiveCell.EntireRow.Insert
        Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Answer 1

<强> TESTED

首先，您应始终避免使用here所述的Select和ActiveCell。

尝试在Set CurrentCell = NextCell行之前添加以下循环：

With Worksheets("Sheet1")
    newYear = .Cells(n, 2).Value
    YearDifference = .Cells(n, 3).Value - newYear
    For j = 0 To YearDifference - 1
        .Cells(n + j, 1).Value = .Cells(n, 1).Value
        .Cells(n + j, 2).Value = newYear
        newYear = newYear + 1
        .Cells(n + j, 3).Value = newYear
    Next j
End With

您需要根据需要更改工作表参考，并且应该在代码的开头标注变量。

修改

用此替换您的代码，它应该有效：

Sub InsertTest() Dim LastRow As Long Dim newYear As Long Dim YearDifference As Long Dim n As Long, j As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual With Worksheets("Sheet1") LastRow = .Cells(Rows.Count, 2).End(xlUp).Row For n = LastRow To 1 Step -1 If n Mod 10 = 0 Then DoEvents If .Cells(n, 1).Value <> "" Then newYear = .Cells(n, 2).Value YearDifference = .Cells(n, 3).Value - newYear If YearDifference > 1 Then Application.StatusBar = "Updating Row #" & n .Range(.Cells(n + 1, 1), .Cells(n + YearDifference - 1, 15)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove For j = 0 To YearDifference - 1 .Rows(n + j).Value = .Rows(n).Value .Cells(n + j, 2).Value = newYear newYear = newYear + 1 .Cells(n + j, 3).Value = newYear Next j End If End If Next n End With Application.StatusBar = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

编辑2 - 代码现在包含每10次迭代运行的DoEvents行。这释放了一些资源，以便代码在后台运行。对于像你这样拥有27,000行的工作表，运行代码可能需要几个小时，但在此期间你应该可以做其他事情。我还添加了一行来更新状态栏，以便您可以看到代码所在的行。

插入缺失年份2年

1 个答案: