VBA F5整段运行无结果/报错，F8逐行运行正常求解

我用VBA从其他工作表提取数据，逐行（F8）运行代码能得到正确结果，但整段（F5）运行时无任何效果且未报错，求原因和解决办法。

数据样式：

原代码：

Sub UpdateOriginalProjectEnd()
    Dim wb As Workbook
    Dim wsTable1 As Worksheet, wsTable2 As Worksheet
    Dim lastRowTable1 As Long, lastRowTable2 As Long
    Dim i As Long, j As Long
    Dim ppmNumber As String
    Dim matchingRecords As Range
    Dim smallestDateSequence As Double
    Dim originalProjectEnd As Range
    Dim latestPLDate As String
    
    Set wb = ThisWorkbook
    Set wsTable1 = wb.Worksheets("JUN-JUL 23") ' Update with the actual worksheet name for Table 1
    Set wsTable2 = wb.Worksheets("Project Date (2)") ' Update with the actual worksheet name for Table 2
    
    ' Find the last row in Table 1
    lastRowTable1 = wsTable1.Cells(wsTable1.Rows.Count, "A").End(xlUp).Row
    
    ' Loop through Table 1
    For i = 2 To lastRowTable1
        ppmNumber = Right(wsTable1.Cells(i, "D").Value, 4) ' Get the last 4 digits of PPM# in Table 1
        
        ' Find matching records in Table 2 based on PPMID
        Set matchingRecords = wsTable2.Range("B:B").Find(What:=ppmNumber, LookIn:=xlValues, LookAt:=xlWhole)
        
        If Not matchingRecords Is Nothing Then
            ' Find records with "LastCycle" in column "A"
            Dim lastCycleRecords As Range
            Set lastCycleRecords = wsTable2.Range("A:A").Find(What:="LastCycle", LookIn:=xlValues, LookAt:=xlWhole)
            
            If Not lastCycleRecords Is Nothing Then
                ' Initialize variables
                smallestDateSequence = 99999999999# ' Set a large initial value
                latestPLDate = DateValue("1/1/1900") ' Set a low initial value
                
                lastRowTable2 = wsTable2.Cells(wsTable2.Rows.Count, "A").End(xlUp).Row
                For j = 2 To lastRowTable2
                    If wsTable2.Cells(j, "B").Value = ppmNumber And wsTable2.Cells(j, "A").Value = "LastCycle" Then
                        Dim currentSequence As Double
                        currentSequence = CDbl(Right(wsTable2.Cells(j, "C").Value, 11)) ' Get the last 11 digits of DateSequence
                                      
                        If currentSequence <> smallestDateSequence Then
                            smallestDateSequence = currentSequence ' Update the smallestDateSequence
                        
                            ' Find the last row within the same DateSequence group
                            Dim lastRowSameSequence As Long
                            lastRowSameSequence = WorksheetFunction.CountIf(Range("C:C"), wsTable2.Cells(j, "C").Value)
                            Dim k As Long
                            Dim PLDate As String
                            
                            For k = j To j + lastRowSameSequence - 1
                                If wsTable2.Cells(k, "B").Value = ppmNumber And wsTable2.Cells(k, "A").Value = "LastCycle" And CDbl(Right(wsTable2.Cells(k, "C").Value, 11)) = currentSequence Then
                                    If wsTable2.Cells(k, "G").Value <> "" Then
                                        ' Compare "PLDate" to find the latest
                                        If wsTable2.Cells(k, "G").Value > PLDate And latestPLDate = DateValue("1/1/1900") Then
                                            PLDate = wsTable2.Cells(k, "G").Value ' Update the latest PLDate
                                        End If
                                    End If
                                End If
                            Next k
                            
                            ' Update the latestPLDate if a non-blank PLDate was found
                            If PLDate > latestPLDate Then
                                latestPLDate = PLDate ' Update the latestPLDate
                            End If
                        End If
                    End If
                Next j
                
                If smallestDateSequence = 99999999999# Then
                    ' No records found with non-blank "PLDate", set "Original Project End" as "N/A"
                    wsTable1.Cells(i, "G").Value = "N/A"
                ElseIf latestPLDate > DateValue("1/1/1900") Then
                    ' Copy the latest "PLDate" to Table 1 "Original Project End"
                    Set originalProjectEnd = wsTable1.Cells(i, "G")
                    originalProjectEnd.Value = latestPLDate
                End If
            Else
                ' No records found with "LastCycle", set "Original Project End" as "N/A"
                wsTable1.Cells(i, "G").Value = "N/A"
            End If
        latestPLDate = DateValue("1/1/1900")
        PLDate = ""
        Else
            wsTable1.Cells(i, "G").Value = "N/A"
        End If
    Next i
End Sub

问题原因分析 #

1. 未限定Range的工作表对象：代码中WorksheetFunction.CountIf(Range("C:C"), wsTable2.Cells(j, "C").Value)的Range("C:C")默认指向当前激活工作表，而非wsTable2。逐行运行时激活表可能刚好是wsTable2，但整段运行时激活表大概率不是，导致CountIf结果错误，后续循环逻辑直接失效。
2. Find方法参数不明确：Find方法会沿用上次搜索的设置（如搜索方向），整段运行时可能因参数残留找不到匹配项，而逐行运行时手动操作重置了参数。
3. 日期变量逻辑漏洞：用字符串类型存储日期，比较时容易出现误差；且PLDate的初始化和判断逻辑有缺陷，整段运行时可能因变量未正确重置导致条件判断出错。

修改后的代码 #

Sub UpdateOriginalProjectEnd()
    Dim wb As Workbook
    Dim wsTable1 As Worksheet, wsTable2 As Worksheet
    Dim lastRowTable1 As Long, lastRowTable2 As Long
    Dim i As Long, j As Long, k As Long
    Dim ppmNumber As String
    Dim matchingRecords As Range, lastCycleRecords As Range
    Dim smallestDateSequence As Double
    Dim latestPLDate As Date, PLDate As Date
    
    Set wb = ThisWorkbook
    Set wsTable1 = wb.Worksheets("JUN-JUL 23")
    Set wsTable2 = wb.Worksheets("Project Date (2)")
    
    ' 关闭屏幕更新，避免激活表切换问题并提升速度
    Application.ScreenUpdating = False
    
    lastRowTable1 = wsTable1.Cells(wsTable1.Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lastRowTable1
        ppmNumber = Right(wsTable1.Cells(i, "D").Value, 4)
        
        ' 明确指定Find所有关键参数，避免沿用上次设置
        Set matchingRecords = wsTable2.Range("B:B").Find(What:=ppmNumber, _
            LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        
        If Not matchingRecords Is Nothing Then
            Set lastCycleRecords = wsTable2.Range("A:A").Find(What:="LastCycle", _
                LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            
            If Not lastCycleRecords Is Nothing Then
                smallestDateSequence = 99999999999#
                latestPLDate = DateValue("1/1/1900")
                lastRowTable2 = wsTable2.Cells(wsTable2.Rows.Count, "A").End(xlUp).Row
                
                For j = 2 To lastRowTable2
                    If wsTable2.Cells(j, "B").Value = ppmNumber And wsTable2.Cells(j, "A").Value = "LastCycle" Then
                        Dim currentSequence As Double
                        currentSequence = CDbl(Right(wsTable2.Cells(j, "C").Value, 11))
                                      
                        If currentSequence <> smallestDateSequence Then
                            smallestDateSequence = currentSequence
                            
                            ' 限定CountIf的Range为wsTable2的C列，避免指向错误工作表
                            Dim lastRowSameSequence As Long
                            lastRowSameSequence = WorksheetFunction.CountIf(wsTable2.Range("C:C"), wsTable2.Cells(j, "C").Value)
                            PLDate = DateValue("1/1/1900") ' 提前初始化PLDate，避免残留值干扰
                            
                            For k = j To j + lastRowSameSequence - 1
                                If wsTable2.Cells(k, "B").Value = ppmNumber And wsTable2.Cells(k, "A").Value = "LastCycle" And _
                                    CDbl(Right(wsTable2.Cells(k, "C").Value, 11)) = currentSequence Then
                                    
                                    If IsDate(wsTable2.Cells(k, "G").Value) Then ' 先判断是否为有效日期
                                        PLDate = wsTable2.Cells(k, "G").Value
                                        ' 直接用Date类型比较，简化逻辑避免误差
                                        If PLDate > latestPLDate Then
                                            latestPLDate = PLDate
                                        End If
                                    End If
                                End If
                            Next k
                        End If
                    End If
                Next j
                
                If smallestDateSequence = 99999999999# Then
                    wsTable1.Cells(i, "G").Value = "N/A"
                ElseIf latestPLDate > DateValue("1/1/1900") Then
                    wsTable1.Cells(i, "G").Value = latestPLDate
                End If
            Else
                wsTable1.Cells(i, "G").Value = "N/A"
            End If
        Else
            wsTable1.Cells(i, "G").Value = "N/A"
        End If
    Next i
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
End Sub

关键修改点 #

• 给所有Range对象加上工作表限定（如wsTable2.Range("C:C")），彻底避免默认指向激活表的问题。
• 明确指定Find方法的所有关键参数，防止参数残留导致的搜索失败。
• 将日期变量改为Date类型，简化比较逻辑，避免字符串比较的误差。
• 提前初始化PLDate，确保每次循环都有正确的初始值。
• 加入Application.ScreenUpdating = False，提升运行速度同时避免激活表切换带来的干扰。

内容的提问来源于stack exchange，提问作者Lister Cheng