VBA累计日期

 

 

Sub count_date()
'计算所有天数，并对日期去重
Dim dic As Object
Dim arr() As Variant
Dim d As Date
Dim cols As Integer

'选5列：1条件列，2开始日期，3结束日期，4,第一列出现次数，5累计天数
arr = Selection
cols = UBound(arr, 2)
Debug.Print cols
For i = 1 To UBound(arr, 1)  '大循环
        Set dic = CreateObject("scripting.dictionary")
    n = 0
    For j = 1 To UBound(arr, 1) '小循环

        If arr(j, 1) = arr(i, 1) Then  '找到同名行
            For d = arr(j, 2) To arr(j, 3) '累计日期
'字典的键名不能重复，使得d重复输入无效，起到去重日期的效果。
                dic(d) = d
            Next
            n = n + 1
        End If
'如果没有选第四列，删除此if和n
        If n > arr(i, 4) Then
            Exit For
        End If
    Next
    arr(i, cols) = dic.Count
Next
'WorksheetFunction.Index(数组, 行数, 列数)，"0"代表整行或整列
Selection.Columns(cols) = WorksheetFunction.Index(arr, 0, cols)
End Sub