Excel VBA日期冲突检测代码异常排查求助

我是VBA新手，编写了用于检测项目日期冲突的OutageWindow宏，预期逻辑为：若项目日期处于指定两个日期范围之一，或范围标记为"Anytime"，则标记"OK"；否则标记"CONFLICT"。但目前存在误判冲突的情况，更新代码后问题依旧，恳请协助排查原因。

初始代码 #

Sub OutageWindow()
'
'This is testing the outage window conflict
'

Dim FoundCell As Range
Dim Subst As String
Dim StartD As String
Dim EndD As String
Dim i As Integer
Dim k As Long

Dim StartRef1 As String
Dim EndRef1 As String

Dim StartRef2 As String
Dim EndRef2 As String

'set a counter for k - which is loopng through each column
Dim LastRow  As Long

LastRow = Range("E" & Rows.Count).End(xlUp).Row

For k = 8 To LastRow

   
'get the cell value
Subst = Sheets("Master").Range("E" & k).Value

StartD = Sheets("Master").Range("K" & k).Value
EndD = Sheets("Master").Range("M" & k).Value

'Set the Range as Col B from the reference sheet and find the Str
Set FoundCell = Sheets("Sub_Ref_Matrix").Range("B:B").Find(What:=Subst)

'initialize Integer i as the row number to locate (more for debugging purpose to see if it is accurate)
i = FoundCell.Row


StartRef1 = Sheets("Sub_Ref_Matrix").Range("C" & i).Value
EndRef1 = Sheets("Sub_Ref_Matrix").Range("D" & i).Value

StartRef2 = Sheets("Sub_Ref_Matrix").Range("E" & i).Value
EndRef2 = Sheets("Sub_Ref_Matrix").Range("F" & i).Value




'If the found cell is not empty, then print message in a column of Master sheet
If FoundCell.Row <> 100 Then
   
   If StartRef1 = "Anytime" And StartRef2 = "Anytime" Then
        Sheets("Master").Range("BB" & k).Value = "OK"
        Sheets("Master").Range("BC" & k).Value = StartD & " and " & EndD & " in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
         
            
   
        'If the start date is within the reference dates then "OK"
       ElseIf (StartD >= StartRef1 And StartD <= EndRef1) And (EndD >= StartRef1 And EndD <= EndRef1) Then
            Sheets("Master").Range("BB" & k).Value = "OK"
            Sheets("Master").Range("BC" & k).Value = StartD & " and " & EndD & " in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
          
                
                
                 'If the project lasts more than (15) 20 weeks AND if the Conflict was "OK" (Not including "Anytime" time frames), then highlight yellow and print "CHECK" instead
        If Sheets("Master").Range("BB" & k).Value = "OK" Then
             If DateDiff("ww", StartD, EndD) > 20 Then
                Sheets("Master").Range("BF" & k).Value = "The Project would last " & DateDiff("ww", StartD, EndD) & " week(s)"
                 Sheets("Master").Range("BB" & k).Value = "CHECK"
            End If
         End If
        
                
             ElseIf (StartD >= StartRef2 And StartD <= EndRef2) And (EndD >= StartRef2 And EndD <= EndRef2) Then
                Sheets("Master").Range("BB" & k).Value = "OK"
                Sheets("Master").Range("BC" & k).Value = StartD & " and " & EndD & " in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
                    
                'If not, then provide info why
                ElseIf (StartD < StartRef1 Or StartD > EndRef1) And (EndD < StartRef1 Or EndD > EndRef1) Then
                Sheets("Master").Range("BB" & k).Value = "CONFLICT"
                   Sheets("Master").Range("BC" & k).Value = StartD & " to " & EndD & " Not in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
        
         ElseIf (StartD < StartRef2 Or StartD > EndRef2) And (EndD < StartRef2 Or EndD > EndRef2) Then
                Sheets("Master").Range("BB" & k).Value = "CONFLICT"
                    Sheets("Master").Range("BC" & k).Value = StartD & " to " & EndD & " Not in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
        End If

    'Provide location of col and row from reference sheet
        Sheets("Master").Range("BE" & k).Value = "The Subst " & Subst & " at B" & i
        Sheets("Master").Range("I" & k).Value = Round(DateDiff("D", StartD, EndD) / 7, 1) & " wks"
        
    End If
'increment k to go through the entire column
Next k
                       
                                     
End Sub

更新后代码 #

Sub OutageWindow()
'
'This is testing the outage window conflict
'

Dim FoundCell As Range
Dim Subst As String
Dim StartD As Variant
Dim EndD As Variant
Dim i As Integer
Dim k As Long



'set a counter for k - which is loopng through each column
Dim LastRow  As Long

LastRow = Range("E" & Rows.Count).End(xlUp).Row

For k = 8 To LastRow

   
'get the cell value
Subst = Sheets("Master").Range("E" & k).Value

StartD = Sheets("Master").Range("K" & k).Value
EndD = Sheets("Master").Range("M" & k).Value

'Set the Range as Col B from the reference sheet and find the Str
Set FoundCell = Sheets("Sub_Ref_Matrix").Range("B:B").Find(What:=Subst)

'initialize Integer i as the row number to locate (more for debugging purpose to see if it is accurate)
i = FoundCell.Row

Dim StartRef1 As Variant: StartRef1 = Sheets("Sub_Ref_Matrix").Range("C" & i).Value
Dim EndRef1 As Variant: EndRef1 = Sheets("Sub_Ref_Matrix").Range("D" & i).Value

Dim StartRef2 As Variant: StartRef2 = Sheets("Sub_Ref_Matrix").Range("E" & i).Value
Dim EndRef2 As Variant: EndRef2 = Sheets("Sub_Ref_Matrix").Range("F" & i).Value


'If the found cell is not empty, then print message in a column of Master sheet
If FoundCell.Row <> 100 Then
   
Select Case True
    Case IsDate(StartRef1)
        Select Case True
            Case (StartD >= StartRef1 And StartD <= EndRef1) And (EndD >= StartRef1 And EndD <= EndRef1)
                 Sheets("Master").Range("BB" & k).Value = "OK"
                 Sheets("Master").Range("BC" & k).Value = StartD & " and " & EndD & " in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2

                
                Case Else
                   Sheets("Master").Range("BB" & k).Value = "CONFLICT"
                   Sheets("Master").Range("BC" & k).Value = StartD & " to " & EndD & " Not in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
           End Select
                
    
    Case IsDate(StartRef2)
        Select Case True
              Case (StartD >= StartRef2 And StartD <= EndRef2) And (EndD >= StartRef2 And EndD <= EndRef2)
                 Sheets("Master").Range("BB" & k).Value = "OK"
                 Sheets("Master").Range("BC" & k).Value = StartD & " and " & EndD & " in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2

                Case Else
                   Sheets("Master").Range("BB" & k).Value = "CONFLICT"
                   Sheets("Master").Range("BC" & k).Value = StartD & " to " & EndD & " Not in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
    End Select
    
    
    Case Not IsNumeric(StartRef1)
        Select Case StartRef1
            Case "Anytime"
                 Sheets("Master").Range("BB" & k).Value = "OK"
                 Sheets("Master").Range("BC" & k).Value = StartD & " and " & EndD & " in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
            'Case "N/A"
    
        End Select
        
         Case Not IsNumeric(StartRef2)
        Select Case StartRef2
            Case "Anytime"
                 Sheets("Master").Range("BB" & k).Value = "OK"
                 Sheets("Master").Range("BC" & k).Value = StartD & " and " & EndD & " in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
            'Case "N/A"
    
        End Select
        End Select
   End If
'increment k to go through the entire column
Next k
     
End Sub

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