使用 Scripting.Dictionary（最大计数）聚合数据

字典非常适​​合管理多个条目出现的信息，但你只关注每组条目的单个值 - 第一个或最后一个值，最小值或最大值，平均值，总和等。

考虑一个包含用户活动日志的工作簿，其中的脚本在每次有人编辑工作簿时插入用户名和编辑日期：

Log 工作表

一个	B
短发	10/12/2016 9:00
爱丽丝	2016 年 10 月 13 日 13:00
短发	2016 年 10 月 13 日 13:30
爱丽丝	2016 年 10 月 13 日 14:00
爱丽丝	2016 年 10 月 14 日 13:00

假设你要将每个用户的上次编辑时间输出到名为 Summary 的工作表中。

注意：
1。数据假定为 ActiveWorkbook。
我们使用数组从工作表中提取值; 这比迭代每个单元更有效。
3. Dictionary 是使用早期绑定创建的。

Sub LastEdit()
Dim vLog as Variant, vKey as Variant
Dim dict as New Scripting.Dictionary
Dim lastRow As Integer, lastColumn As Integer
Dim i as Long
Dim anchor As Range

With ActiveWorkbook
    With .Sheets("Log")
        'Pull entries in "log" into a variant array
        lastRow = .Range("a" & .Rows.Count).End(xlUp).Row
        vlog = .Range("a1", .Cells(lastRow, 2)).Value2

        'Loop through array
        For i = 1 to lastRow
            Dim username As String
            username = vlog(i, 1)
            Dim editDate As Date
            editDate = vlog(i, 2)

            'If the username is not yet in the dictionary:
            If Not dict.Exists(username) Then
                dict(username) = editDate
            ElseIf dict(username) < editDate Then
                dict(username) = editDate
            End If
        Next
    End With

    With .Sheets("Summary")
        'Loop through keys
        For Each vKey in dict.Keys
            'Add the key and value at the next available row
            Anchor = .Range("A" & .Rows.Count).End(xlUp).Offset(1,0)
            Anchor = vKey
            Anchor.Offset(0,1) = dict(vKey)
        Next vKey
    End With
End With
End Sub

输出将如下所示：

Summary 工作表

一个	B
短发	2016 年 10 月 13 日 13:30
爱丽丝	2016 年 10 月 14 日 13:00

另一方面，如果要输出每个用户编辑工作簿的次数，则 For 循环的主体应如下所示：

        'Loop through array
        For i = 1 to lastRow
            Dim username As String
            username = vlog(i, 1)

            'If the username is not yet in the dictionary:
            If Not dict.Exists(username) Then
                dict(username) = 1
            Else
                dict(username) = dict(username) + 1
            End If
        Next

输出将如下所示：

Summary 工作表

一个	B
短发	2
爱丽丝	3