Excel 在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

测试

首先，您应该始终避免使用如上所述的Select和ActiveCell

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

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

编辑

用以下代码替换您的代码，它应该可以工作：

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-代码现在包括一个DoEvents行，每10次迭代运行一次。这将释放一些资源，以便代码在后台运行。对于像您这样有27000行的工作表，运行代码可能需要几个小时，但您应该能够同时执行其他操作。我还添加了一条更新状态栏的代码，这样你就可以看到代码在哪行了。< /P>我把它添加到代码中，它仍然只给了我空白行。试试使用Debug。打印或MsgBox来查看你的值是什么年和年差。我在哪里添加？？2.值行并在YearDifference=.Cellsn之后添加MsgBox YearDifference，3.值-新年行。运行您的代码并查看每个迭代中的这些值。如果它们不是数值，那么像我做的那样减去它们将不起作用。我以为我已经做到了……我应该将ActiveCell.EntireRow.Copy放在哪里以在插入之前复制整个单元格？我把I=1放在CurrentCell后面，但我只是在。。。

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