宏Excel循環

Question

我在Excel中循環宏的問題。 我有一個數據庫，我需要在每個唯一值上面添加一行，並將下面的值複製到新行中。 直到現在我已經想出了這一點：

Sub Test() 
' 
' Sneltoets: Ctrl+K 
' FindNextValueChangeInColumn Macro 
' 
Dim currentValue As String 
Dim compareValue As String 

currentValue = ActiveCell.Value 

If (currentValue = "") Then 
    Selection.End(xlDown).Select 
Else 
    ActiveCell.Offset(1, 0).Select 
    compareValue = ActiveCell.Value 

    Do While currentValue = compareValue 
    ActiveCell.Offset(1, 0).Select 
    compareValue = ActiveCell.Value 
    Loop 

    Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove 
    ActiveCell.Offset(1, 0).Select 
    Selection.Copy 
    ActiveCell.Offset(-1, 0).Select 
    Selection.PasteSpecial 
End If 

Exit Sub 
End Sub 

這個宏做的工作，但我不想按ctrl-K，每次的更新是必要的4000倍。任何人都知道如何循環這個宏？

Answer 1

只是包裝爲一個圍繞要執行的代碼迴路：

Sub Test() 
' 
' Sneltoets: Ctrl+K 
' FindNextValueChangeInColumn Macro 
' 

'-------Loop from 1 to 4000------------ 
Dim loopy 
For loopy = 1 to 4000 'Loop 4000 times 
'-------------------------------------- 

    Dim currentValue As String 
    Dim compareValue As String 

    currentValue = ActiveCell.Value 

    If (currentValue = "") Then 
     Selection.End(xlDown).Select 
    Else 
     ActiveCell.Offset(1, 0).Select 
     compareValue = ActiveCell.Value 

     Do While currentValue = compareValue 
     ActiveCell.Offset(1, 0).Select 
     compareValue = ActiveCell.Value 
     Loop 

     Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove 
     ActiveCell.Offset(1, 0).Select 
     Selection.Copy 
     ActiveCell.Offset(-1, 0).Select 
     Selection.PasteSpecial 
    End If 

'-----Don't forget this line----- 
Next loopy 
'-------------------------------- 

Exit Sub 
End Sub 

或者，你可以使用while循環進行循環，直至到currentValue = 「」：

Do 
    currentValue = ActiveCell.Value 

    If (currentValue = "") Then 
     Selection.End(xlDown).Select 
    Else 
     ActiveCell.Offset(1, 0).Select 
     compareValue = ActiveCell.Value 

     Do While currentValue = compareValue 
      ActiveCell.Offset(1, 0).Select 
      compareValue = ActiveCell.Value 
     Loop 

     Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove 
     ActiveCell.Offset(1, 0).Select 
     Selection.Copy 
     ActiveCell.Offset(-1, 0).Select 
     Selection.PasteSpecial 
    End If 

Loop While currentValue <> ""