簡體   English   中英

僅在單步執行代碼時運行代碼-競爭條件?

[英]Code Only Runs When Stepping Through Code - Race Condition?

當我使用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

任何提示或想法將不勝感激。 謝謝。

您應該使您的參考文獻合格:

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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM