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

<强>输出

Answer 2

当循环开始时，For循环的边界计算一次，然后变为平数。如果要更改边界，请回退到Do循环：

j = 3
Do

    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 + 3
    End If

Loop While j < FinalRow