Question

我有一个宏，当我使用F8逐步执行代码时似乎起作用，但是当我尝试运行整个子程序或通过用户将其推入工作表的按钮调用它时，该宏就无效。

当我完整地运行代码时，我可以告诉它执行了某些步骤，但不是全部。

我已经阅读了一些有关此情况的现有帖子，似乎每次该人使用大量.Select .Activate时，等等。我没有使用这些命令，因此我尝试以更大的动态设置工作表和变量。我还包括了Application.ScreenUpdating = False。

由于我没有使用这些类型的命令，因此我假设这是某种竞争条件，需要更多时间才能暂停。我尝试添加几行Application.Wait(Now + TimeValue("00:00:01"))，但是当我将这些行添加到VBA代码中时，当我尝试运行整个代码时，它将完全冻结Excel。不知道为什么会这么做，但是我必须在任务管理器中杀死Excel。

这是VBA，对于我添加的所有评论表示抱歉：

Sub CombineExcels()
'***** This sub is to autofilter for each available filter option and put the matching Excel file paths into one cell on the FINAl sheet *****

UserForm1.Show vbModeless

'***** Setting variables *****
Dim RngOne As Range, cell As Range
Dim LastCell As Long
Dim LastCellC As Long
Dim Row As Long
Dim i As Integer
Dim count As Integer
Dim s As String
Dim EnterVal As Range
Dim FirstUsedRow As Long
Dim FirstEmptyCell As Long

'***** In the event of an error, we will skip to our Error Handler *****
On Error GoTo EH

'***** Turn off Excel Screen Updating so the screen doesn't keep flashing and slow the macro *****
Application.ScreenUpdating = False

'***** Finding the last used row, first empty row, and largest range that we will work with *****
With Sheets("Final")
    LastCell = .Range("A" & Sheets("Final").Rows.count).End(xlUp).Row
    LastCellC = .Range("C" & Sheets("Final").Rows.count).End(xlUp).Row + 1
    Set RngOne = .Range("A2:A" & LastCell)
End With

'***** This section is a loop that will apply the filter for each option and combine the results onto the Final sheet *****
For Each cell In RngOne
    With Sheets("Folder Output")
        '***** If a filter is already applied, we will remove the filter *****
        If .FilterMode Then .ShowAllData
        '***** Clearing any remaining data from the location we will temporarily store file paths in *****
        Worksheets("Final").Range("Q1:Q100").Clear
        '***** Apply the filter. The criteria is named CELL which is a loop for each filter option *****
        .Columns("A").AutoFilter Field:=1, Criteria1:=cell
        '***** Find the last row of filter results in Column C *****
        Row = .Range("C" & Sheets("Folder Output").Rows.count).End(xlUp).Row
        '***** If the row number returned is 2 then we know that there is only 1 file path result *****
        If Row = "2" Then Row = .Range("C" & Sheets("Folder Output").Rows.count).End(xlUp).Row + 1
        '***** Setting a new range for only the filtered results in Column C *****
        Dim rng As Range: Set rng = .Range("C2:C" & Row).SpecialCells(xlCellTypeVisible)
            Dim rngCell As Range
            '***** Loop to get each result and place it on the FINAL sheet in column Q for now *****
            For Each rngCell In rng
                    If Sheets("Final").Range("Q1").Value = "" Then
                        FirstEmptyCell = .Range("Q" & Sheets("Final").Rows.count).End(xlUp).Row
                        Worksheets("Final").Range("Q" & FirstEmptyCell) = rngCell.Value
                    Else
                        FirstEmptyCell = .Range("Q" & Sheets("Final").Rows.count).End(xlUp).Row + 1
                        Worksheets("Final").Range("Q" & FirstEmptyCell) = rngCell.Value
                    End If
            '***** Continue to the next filtered result until all file paths for that filter are complete *****
            Next rngCell

        '***** Finding the last used row from the pasted file path results in Column Q *****
        count = Sheets("Final").Cells(Rows.count, "Q").End(xlUp).Row
        '***** Loop to combine all the paths into one string but separate the paths with a ; *****
        For i = 1 To count
            If Cells(i, 17).Value <> "" Then s = s & Cells(i, 17).Value & ";"
        Next
            '***** Find the last used row from Column C in the Final sheet. Then paste the combined file paths to Column C *****
            Set EnterVal = Worksheets("Final").Range("C" & LastCellC)
            EnterVal.Value = s
            Set EnterVal = Nothing
            s = ""
        '***** This tells the macro to move a row down next time through the loop *****
        LastCellC = LastCellC + 1
    End With
Next

'***** Once the loop is finished, we will end this sub in the CleanUp section *****
GoTo CleanUp

'***** Before exiting the sub we will turn Screen Updating back on and notify the user the Excel file paths are combined *****
CleanUp:
    On Error Resume Next
    Application.ScreenUpdating = True
    UserForm1.Hide
    MsgBox ("Excel File Paths Have Been Concatenated!")
Exit Sub
'***** If an error occurs during the loop, we go here to redirect to turn updating on and end the sub *****
EH:
    ' Do error handling
    GoTo CleanUp

End Sub

我可以告诉我，当我运行整个代码时，它会进行所有过滤，并且我相信将结果放在“最终”工作表的Q列中，但是这些结果不会与;合并在一起。作为分隔符，然后作为包含多个路径的一个字符串放在C列中。

所以我认为问题在这里附近发生，但不确定：

'***** Finding the last used row from the pasted file path results in Column Q *****
        count = Sheets("Final").Cells(Rows.count, "Q").End(xlUp).Row
        '***** Loop to combine all the paths into one string but separate the paths with a ; *****
        For i = 1 To count
            If Cells(i, 17).Value <> "" Then s = s & Cells(i, 17).Value & ";"
        Next
            '***** Find the last used row from Column C in the Final sheet. Then paste the combined file paths to Column C *****
            Set EnterVal = Worksheets("Final").Range("C" & LastCellC)
            EnterVal.Value = s
            Set EnterVal = Nothing
            s = ""
        '***** This tells the macro to move a row down next time through the loop *****
        LastCellC = LastCellC + 1
    End With
Next

任何提示或想法将不胜感激。谢谢。

Answer 1

您应该使您的推荐人符合条件：

count = Sheets("Final").Cells(Rows.count, "Q").End(xlUp).Row

应该是：

With Sheets("Final)
    count = .Cells(.Rows.count, "Q").End(xlUp).Row
End with

与上述类似，在使用with语句时，您还添加了条件：

Row = .Range("C" & Sheets("Folder Output").Rows.count).End(xlUp).Row '.Rows.Count as sheet is already qualified

仅在单步执行代码时运行代码-竞争条件？

1 个答案: