检查日期冲突VBA Excel

Question

我需要一些帮助，试图找出为什么这段代码是这样工作的。在某些日期，它会说发生了不应该发生的冲突。太好了，我能在这方面得到一些帮助。我对VBA比较陌生，我花了很长时间才想出解决这个问题的办法。

代码的工作方式应该是，如果日期在两个日期范围中的任何一个，那么它会说"OK“或者如果它说”任何时候“，那么它也会说"OK”，因为这意味着项目可以在任何时候开始。但是，如果日期不在给定的两个日期范围的任何一个范围内，则会说“冲突”。

例如，如果日期在8/1/2022 - 8/30/2022之间，或者不在这些日期内，它将与第二个日期范围9/2/2022-9/20/2022相比较。日期必须属于其中之一，这样才能“确定”，如果不是，那就是“冲突”。

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

Answer 1

使用StartRef1 (未测试)确定Select中数据格式的快速示例：

Dim StartRef1 as Variant:  StartRef1 = Sheets("Sub_Ref_Matrix").Range("C" & i).Value
Select Case True
    Case IsDate(StartRef1)
        Select Case True
            Case StartD >= StartRef1 And EndD <= EndRef1
                'Do one
            Case Else
                'Do two
        End Select
    Case Not IsNumeric(StartRef1)
        Select Case StartRef1.Value
            Case "Anytime"
                'Do something
            Case "N/A"
                'Do something else
            Case Else
                MsgBox "This is not a date, nor does it contain *Anytime* or *N/A*"
        End Select
End Select

目前，您有Dim StartRef1 as String: StartRef1 = Sheets("Sub_Ref_Matrix").Range("C" & i).Value，这可能导致无法比较数字/日期，例如，您无法确定是否StartD >= StartRef1。

如果您确保您有一个日期(IsDate())，那么您可以比较.同样，您需要确保StartD和其他变量的类型相同。

Edit1:

快速更新，仅显示月/日的比较，在IsDate()之后，使用固定年份而不考虑年份：

Dim StartRef1 as Variant:  StartRef1 = Sheets("Sub_Ref_Matrix").Range("C" & i).Value
Select Case True
    Case IsDate(StartRef1)
        Select Case True
            Case DateSerial(1900,Month(StartD),Day(StartD)) >= DateSerial(1900,Month(StartRef1),Day(StartRef1)) And DateSerial(1900,Month(EndD),Day(EndD)) >= DateSerial(1900,Month(EndRef1),Day(EndRef1)) And StartD <= EndD
                'Do one
            Case Else
                'Do two
        End Select
    Case Not IsNumeric(StartRef1)
        Select Case StartRef1.Value
            Case "Anytime"
                'Do something
            Case "N/A"
                'Do something else
            Case Else
                MsgBox "This is not a date, nor does it contain *Anytime* or *N/A*"
        End Select
End Select