具有变量索引的Excel VBA For循环不起作用

Question

我的数据集看起来像这样

Name    ID

Alice   1

Alice   2

Alice   -4

Bob    4

Bob    7

2344   9

2344   10

4I    99

4I   04

我希望它看起来像这样:

Name    ID

Alice   1

Alice   2

Alice   -4



Name    ID

Bob    4

Bob    7




Name    ID

2344   9

2344   10



Name    ID

4I    99

4I   04

每次名称条目更改时，我都想引入 1 个空行和一行我的标题。

    Sub insertingrows()


  FinalColumn = Cells(1, Columns.Count).End(xlToLeft).Column
  FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

  For j = 3 To FinalRow

    If Cells(j, 2) <> Cells(j - 1, 2) Then
        'Rows(j & ":" & j + 2).Insert
        Rows(j).Insert
        Rows(1).Copy
        Rows(j + 1).Insert
        FinalRow = FinalRow + 2
        j = j + 2
    End If

  Next j



End Sub

我的初始实际数据有 3830 行，但即使我在循环内更新我的变量 FinalRow，循环仍然在 3830 附近停止，并且还有很多未完成的过程。这是 For 的限制吗？我应该使用其他类型的循环吗？

Answer 1

假设您的工作表如下所示



将此代码放入模块中

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")

    Application.ScreenUpdating = False

    With ws
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = lRow To 3 Step -1
            If .Cells(i, 1).Value <> .Cells(i - 1, 1).Value Then
                .Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                .Cells(i, 1).Value = "Name": .Cells(i, 2).Value = "ID"
                .Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        Next i
    End With

    Application.ScreenUpdating = True
End Sub

输出