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

我正在寻找Col A中的“Sum”字样，用于工作簿中除“master”表之外的每张工作表。

Answer 1

当你插入一行然后继续循环时，你将再次以“Sum”结尾（由于插入而被推下一行）。因此，您的代码将在一行一行之后逐行插入...永远

尝试使用此代码（在If中）...也许不是最好的解决方案，但它有效：

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 2

由于列中只有一个总和

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 3

您正在遍历工作表但不使用每个单独的工作表作为单元格的父工作表。如果没有合格的父工作表，则每个单元格都默认为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是Sum，那么您尝试在第0行插入一行。没有第0行。

Answer 4

而不是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 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

我从堆叠的某个地方得到了这个，但我忘了哪个帖子，所以如果你是那个做这个的人，谢谢。：）

VBA：在找到的单元格之前插入一个新行

5 个答案: