由於沒有原始數據,僅就代碼運行解析下:
Private?Sub?CommandButton1_Click()Dim?r%
Dim?i%
Dim?arr
Dim?brr
Dim?d?As?Object
Set?d?=?CreateObject("scripting.dictionary")?'建立?字典?對象
With?Worksheets("sheet2")
r?=?.Cells(.Rows.Count,?1).End(xlUp).Row?'獲取?sheet2?表最後壹行
arr?=?.Range("a2:b"?&?r)?'獲取?a2?到?b列最後壹行?的數據,並生成二維數組
'根據上面的二維數組,生成字典
For?i?=?1?To?UBound(arr)?'遍歷數組
If?Not?d.Exists(arr(i,?1))?Then?'如果字典中不存在?arr(i,?1)
Set?d(arr(i,?1))?=?CreateObject("scripting.dictionary")?'設置字典數據
End?If
d(arr(i,?1))(arr(i,?2))?=?""
Next
c?=?.Cells(5,?.Columns.Count).End(xlToLeft).Column?'獲取第5行的最後壹列號
.Range("f6").Resize(1,?c?-?5).ClearContents?'清除?F6?單元格,下移1行,右移?c-5?列區域的內容
arr?=?.Range("f5").Resize(2,?c?-?5)?'獲取?f5?單元格,下移2行,右移?c-5?列?內容,並保存至數組
For?j?=?1?To?UBound(arr,?2)?'獲取數組第2維的最大記錄數
brr?=?Split(arr(1,?j),?"-")?'對數組的第1維元素,用?split?分割
For?k?=?CDate(brr(0))?To?CDate(brr(1))?'轉換上面分割的字符串為日期類型,並循環
If?d.Exists(k)?Then?'如果字典中存在該日期
arr(2,?j)?=?arr(2,?j)?+?d(k).Count?'將?arr(2,j)?的內容修改為?原內容+字典中相應鍵的總計
End?If
Next
Next
.Range("f5").Resize(UBound(arr),?UBound(arr,?2))?=?arr?'將數組寫回單元區域
End?With
End?Sub