vba - Excel VBA代码，一个宏在单独运行时工作，但在一组运行时调试

Question

我的程序通过调用一些宏来工作：

Sub Start()

Call ClearAll
Call Sales_Download
Call Copy_Sales
Call Receipt_Download
Call Copy_Receipt
Call Copy1
Call Sales_Summary
Call Copy2
Call Receipt_Summary

End Sub

我的程序在 copy2 处中断，它本质上是 copy1 的精确复制品，工作正常。当 copy2 自行运行时，它可以完美运行，但是当我尝试运行整个程序时，它会进行调试。粗线是调试发生的地方。

Sub Copy2()

 ' Copies all data from Receipt Download tab for each location, and saves in a seperate folder

Dim i As Long
Dim lngLastRow As Long, lngPasteRow As Long

'Find the last row to search through
lngLastRow = Sheets("Receipt_Download").Range("J65535").End(xlUp).Row

'Initialize the Paste Row
lngPasteRow = 2
Dim rng As Range
Dim c As Range
Dim endrow
Dim strName As String
Dim ws As Worksheet
Dim j As Long
endrow = Sheets("names").Range("A65000").End(xlUp).Row
Set rng = Sheets("names").Range("A2:A" & endrow)
j = 1
FBO = strName


For Each c In rng


For i = 2 To lngLastRow
    strName = c.Value
    If Sheets("Receipt_Download").Range("J" & i).Value = strName Then
        Sheets("Receipt_Download").Select
        Range("A" & i & ":IV" & i).Copy
        Sheets("Summary").Select
        Range("A" & lngPasteRow & ":IV" & lngPasteRow).Select
        ActiveSheet.Paste
        lngPasteRow = lngPasteRow + 1

    End If
Next i
j = j + 1
        Sheets("Receipt_Download").Select
        Rows("1:1").Select
        Selection.Copy
        Sheets("Summary").Select
        Rows("1:1").Select
        ActiveSheet.Paste
        Columns("D:E").Select
        Selection.NumberFormat = "m/d/yyyy"
        Sheets("Summary").Select
        Range("B25000").Select
        ActiveCell.FormulaR1C1 = "Grand Total"
        Range("B25000").Select
        Selection.Font.Bold = True
        Columns("G:G").Select
        Selection.Insert Shift:=xlToRight
        Range("G1").Select
        ActiveCell.FormulaR1C1 = "=IF(RC[-2]=0,""0"",RC[-1])"
        Range("G1").Select
        Selection.AutoFill Destination:=Range("G1:G24950")
        Range("G25000").Select
        ActiveCell.FormulaR1C1 = "=SUM(R[-24950]C:R[-1]C)"
        Range("G25000").Select
        Selection.Copy
        Range("F25000").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Columns("G:G").Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlToLeft
        Sheets("Summary").Select
        Range("F25000").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Names").Select
        With Columns("B")
        .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
        End With
        ActiveSheet.Paste
        Sheets("Summary").Select
        Range("b1:b30000").Select
        For Each Cell In Selection
        If Cell.Value = "" Then
        Cell.ClearContents
        End If
        Next Cell
        Range("b1:b30000").Select
        Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        Sheets("Summary").Select
        Range("D2").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Names").Select
        ***With Columns("C")
        .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate***
        End With
        ActiveSheet.Paste
        Sheets("Summary").Select
        Range("A1:Z5000").Select
        Selection.Copy
        Workbooks.Add
        ActiveSheet.Paste
        Range("A1").Select
        Application.CutCopyMode = False
        Selection.Copy
        Application.CutCopyMode = False
        File = "C:\Documents and Settings\user\Desktop\New FBO\" & strName & "\" & strName & " Receipts.xls"
        ActiveWorkbook.SaveAs Filename:=File, _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        ActiveWorkbook.Close
        IngPasteRow = IngPasteRow + 1
        Sheets("Summary").Select
        Selection.ClearContents
Next c

End Sub

我真的很感谢任何帮助，我当然不是 VBA 大师，这很麻烦。

Answer 1

替换这部分代码

 Sheets("Summary").Select
 Range("D2").Select
 Application.CutCopyMode = False
 Selection.Copy
 Sheets("Names").Select
 With Columns("C")
 .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
 End With
 ActiveSheet.Paste

和

Dim lRow As Long

With Sheets("Names")
    lRow = .Range("C" & .Rows.Count).End(xlUp).Row + 1

    Sheets("Summary").Range("D2").Copy .Range("C" & lRow)
End With

现在试试看。

还有一些tips

1. 避免它们是错误.Select的.Activate主要原因
2. 缩进并适当地注释您的代码。您的代码很难阅读。如果您不缩进/注释您的代码，您将意识到如果您在一周后访问它，您将无法识别您的 OWN 代码:)

Answer 2

为了支持上面 Siddharth 的回答，我已经采用了您的一部分代码（直到您的中断发生的位置），并缩进并避免了他提到的.Selectand 。.Activate希望这能为您提供一个良好的开端，让您了解如何使您的代码更具可读性，以便于调试和理解。

For Each c In rng


    For i = 2 To lngLastRow

        strName = c.Value

        If Sheets("Receipt_Download").Range("J" & i).Value = strName Then

            Sheets("Receipt_Download").Range("A" & i & ":IV" & i).Copy _
                Destination:=Sheets("Summary").Range("A" & lngPasteRow & ":IV" & lngPasteRow)
            lngPasteRow = lngPasteRow + 1

        End If
Next i

j = j + 1

Sheets("Receipt_Download").Rows("1:1").Copy Destination:=Sheets("Summary").Rows("1:1")

With Sheets("Summary")

    .Columns("D:E").NumberFormat = "m/d/yyyy"

    With .Range("B25000")
        .Formula = "Grand Total"
        .Font.Bold = True
    End With

    .Columns("G:G").Insert Shift:=xlToRight

    With Range("G1")
        .FormulaR1C1 = "=IF(RC[-2]=0,""0"",RC[-1])"
        .AutoFill Destination:=Range("G1:G24950")
    End With

    With ("G25000")
        .FormulaR1C1 = "=SUM(R[-24950]C:R[-1]C)"
        .Copy
    End With

    .Range("F25000").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    .Columns("G:G").Delete Shift:=xlToLeft

    .Range("F25000").Copy Destination:=Sheets("Names").Columns("B").Find(what:="", after:=Sheets("Names").Cells(1, 1), LookIn:=xlValues)

End With