VBA：見つかったセルの前に新しい行を挿入

Question

以下は実行しているコードです。私が望むものが得られるかどうかは分かりません。
しかし、不思議なことに、コードの実行には時間がかかりすぎています。
私はそれを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 
     End If 
    Next Acell 
End If 
Next ws 

「マスター」シート以外のブックのすべてのシートについて、Col 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

行を挿入してループを続行すると、「挿入」によって再度1行下にプッシュされている「合計」-rowになります。したがって、あなたのコードは、おそらくない最善の解決策...（もし内側）このコードを試してみてください永遠に...行の後の行の後の行の後に

を行を挿入しますが、それは動作します：そこ以来

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になります。あなたは、行1で開始しているとA1が和であるならば、あなたは、行0の行を挿入しようとしている

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 

ノートには、行ゼロはありません。

Answer 5

は、あなたが手動にワークブックの計算を設定しようとしたことがあり、私はこれが役に立ったと評価してい私は、シートの負荷とワークブックですべてのシートを作業する傾向があるので、式の負荷を持っています。

File>Options>Formulas 

次に、ワークブックの計算を手動に設定しますが、自動化したい場合はこの設定にしてください。

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 

私はどこか、スタック内からこれを得たが、あなたはこれをしなかった1、感謝しているので、もし私が、そのポストを忘れてしまいました。 :)