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 

我得到这个从某处堆栈，但我忘了哪个职位，所以如果你是一个谁这样做，谢谢。 :)