检查日期与VBA Excel冲突

Question

我需要一些帮助来弄清楚为什么这个代码会这样工作。有些日期它会说有冲突，而不应该有冲突。如果我能在这方面得到一些帮助，那就太好了。我对VBA还比较陌生，我花了很长时间才想出解决这个问题的办法。

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

例如，如果日期在2022年1月8日至2022年8月30日之间，或者不在这些日期内，则它将与第二个日期范围(例如2022年2月9日至2020年9月20日(进行比较。日期必须属于其中之一；OK"；如果不是；"冲突"；

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

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

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和其他变量的类型相同。

---

第1版：

快速更新，仅显示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