宏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

只需在您想要执行的代码周围换一个for循环：

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 <> ""