貼吧提問《如何在相同編碼里诺擅，判斷是否有日期重疊》省骂，對多組日期期間是否有重疊的日期進(jìn)行計(jì)算，參考貼子回復(fù)編寫代碼榄鉴，使其更具通用性
一個(gè)自定義函數(shù)計(jì)算和一個(gè)過程（函數(shù)參數(shù)為二維數(shù)組）
Function date_overlap(dates)
'函數(shù)定義date_overlap(日期二維數(shù)組(開始日期编检，結(jié)束日期))，返回結(jié)果各日期期間重疊的日期(str)
Dim dict As Object, result As String
Set dict = CreateObject("scripting.dictionary")
For i = 1 To UBound(dates):
For j = dates(i, 1) To dates(i, 2):
If Not dict.Exists(j) Then '新鍵-值（日期-出現(xiàn)次數(shù)）
dict(j) = 1
Else '已有鍵-值，更新
dict(j) = dict(j) + 1
End If
Next
Next
k = dict.keys
v = dict.Items
For i = 0 To dict.count - 1: '遍歷字典
If v(i) > 1 Then
result = result & k(i) & "同波，" '拼接重疊日期
End If
Next
date_overlap = result
dict.RemoveAll '清除字典鳄梅，釋放內(nèi)存
End Function
Sub 日期期間重疊()
Dim arr, brr, k, v, res, dict As Object
Set dict = CreateObject("scripting.dictionary")
arr = [a1].CurrentRegion
For i = 2 To UBound(arr): '編碼去重，統(tǒng)計(jì)出現(xiàn)次數(shù)未檩，以便重新定義brr數(shù)組
If Not dict.Exists(arr(i, 1)) Then '新鍵-值
dict(arr(i, 1)) = 1
Else
dict(arr(i, 1)) = dict(arr(i, 1)) + 1
End If
Next
k = dict.keys
v = dict.Items
For i = 0 To dict.count - 1: '遍歷字典
ReDim brr(1 To v(i), 1 To 2) '重新定義brr數(shù)組
x = 1
For j = 2 To UBound(arr): '遍歷arr數(shù)組
If k(i) = arr(j, 1) Then
brr(x, 1) = arr(j, 2): brr(x, 2) = arr(j, 3) '賦值brr數(shù)組
x = x + 1
End If
Next
res = date_overlap(brr) '調(diào)用函數(shù)戴尸，獲取結(jié)果
row_write = [g1].CurrentRegion.Rows.count + 1 '輸出結(jié)果區(qū)域的第一個(gè)空行寫入
If res <> "" Then '寫入結(jié)果
Cells(row_write, 7).Resize(1, 3) = Array(k(i), "是", res)
Else
Cells(row_write, 7).Resize(1, 3) = Array(k(i), "否", res)
End If
Next
End Sub
舉例：
日期重疊-舉例
