VBA：在找到單元格之前插入一個新行

Question

下面是我正在運行的代碼，我不太確定是否可以得到我想要的。
但奇怪的是，代碼運行時間太長。
我等了一個小時。
所以我覺得代碼中一定有一些錯誤。
任何人都可以對此有所瞭解嗎？

Set x = Workbooks.Open("C:\Users\Desktop\testing.xlsx") 

For Each ws In x.Worksheets 
If ws.Name <> "Master" Then 
    lrow = ws.Cells(Rows.Count, "A").End(xlUp).Row 
    Set rng = ws.Range(Cells(1, 1), Cells(lrow, 1)) 
    For Each Acell In rng 
     If (Acell.Value = "Sum") Then 
      Acell.Offset(-1, 0).EntireRow.Insert 
     End If 
    Next Acell 
End If 
Next ws 

我正在尋找在柱A說：「總」字，除了爲「主」片在工作簿每個表。

Answer 1

而不是For Each循環使用For i = lRow to 1 Step -1，然後使用i訪問每一行：If ws.Cells(i, 1) = "Sum" Then ws.Rows(i).Insert。

當從底部循環時，插入/刪除行不會影響上面的行（尚未處理），而是僅在下面的行（已處理）。

Dim iRow As Long, lRow As Long 
Dim ws As Worksheet 
Dim x As Workbook 

Set x = Workbooks.Open("C:\Users\Desktop\testing.xlsx") 

For Each ws In x.Worksheets 
    If ws.Name <> "Master" Then 
     lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 
     For iRow = lRow To 1 Step -1 'walk through rows from last row (lRow) to first row going upwards (Step -1) 
      If ws.Cells(iRow, 1) = "Sum" Then 
       ws.Rows(iRow).Insert xlDown 'insert new row and move other rows down 
       Exit For 'if there is only one "Sum" you can exit for here (to shorten the run time) 
          'if there are more that one "Sum" in a sheet then remove that line. 
      End If 
     Next iRow 
    End If 
Next ws 

Answer 2

當您插入一行然後繼續循環時，您將再次結束「Sum」行（由於Insert，它已被向下壓一行）。因此，你的代碼將一行之後一排排後插入一行...永遠

試試這個代碼（如內部）......也許不是最好的解決辦法，但它的工作原理：

lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row 
R = 1 
Do Until R > lastrow 
    If (ws.Cells(R, 1).Value = "Sum") Then 
     ws.Cells(R, 1).EntireRow.Insert 
     R = R + 1    ' Jump one extra step (to skip the inserted row) 
     lastrow = lastrow+ 1 ' The last row is increased due to the inserted row 
    End If 
    R = R + 1 
Loop 

Answer 3

由於在列中只有1個總和

Set x = Workbooks.Open("C:\Users\Desktop\testing.xlsx") 

For Each ws In x.Worksheets 
If ws.Name <> "Master" Then 
    lrow = ws.Cells(Rows.Count, "A").End(xlUp).Row 
    Set rng = ws.Range(Cells(1, 1), Cells(lrow, 1)) 
    For Each Acell In rng 
     If (Acell.Value = "Sum") Then 
      Acell.Offset(-1, 0).EntireRow.Insert 
     exit for 
     End If 
    Next Acell 
End If 
Next ws 

試試這段代碼。

Answer 4

您正在循環瀏覽工作表，但並未將每個單獨的工作表用作父單元格的工作表。如果沒有合格的父工作表，每個單元格只是默認爲ActiveSheet。

For Each ws In x.Worksheets 
    If ws.Name <> "Master" Then 
     with ws 
      lrow = .Cells(.Rows.Count, "A").End(xlUp).Row 
      Set rng = .Range(.Cells(1, 1), .Cells(lrow, 1)) 
      For Each Acell In rng 
       If Acell.Value = "Sum" Then 
        Acell.Offset(-1, 0).EntireRow.Insert 
       End If 
      Next Acell 
     end with 
    End If 
Next ws 

注意，你開始第1行中，如果A1是求和，那麼你正在嘗試爲0行插入行沒有排爲零。

Answer 5

你試過工作簿計算設置爲手動，我發現這是很有幫助的，因爲我傾向於工作簿的工作與張的每片的負載具有式的負載。

File>Options>Formulas 

然後將Workbook Calculations設置爲手動，但是如果您想自動執行此操作。

Sub Macro1() 
' 
' Macro1 Macro 
' 
' Keyboard Shortcut: Ctrl+e 
' 
    calcu 
    'your code here 

    ActiveWorkbook.Application.Calculation = xlCalculationAutomatic 

End Sub 

「=

Function calcu() 

    Dim xlCalc As XlCalculation 

    xlCalc = Application.Calculation 
    ActiveWorkbook.Application.Calculation = xlCalculationManual 
    On Error GoTo CalcBack 
    Exit Function 

CalcBack: 
    ActiveWorkbook.Application.Calculation = xlCalc 

End Function 

我得到這個從某處堆棧，但我忘了哪個職位，所以如果你是一個誰這樣做，謝謝。 :)