Excel的VBA對於不工作

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