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

现在尝试一下。

也很少提示

避免.Select和.Activate他们是错误的主要原因
缩进并适当评论您的代码。您的代码很难阅读。如果您没有缩进/评论您的代码，您将意识到，如果您在一周后访问该代码，您将无法识别您的OWN代码：）

Answer 2

为了支持上面的Siddharth的答案，我已经拿走了你的一部分代码（直到你的休息发生的地方）并且缩进并避免了他提到的.Select和.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

Excel VBA代码，一个宏在自己运行时工作，但在组中运行时进行调试

2 个答案: