为何无法将日期+小时作为Dictionary键、风向作为项合并数据？

原代码无法按日期+小时组合合并数据的核心原因是：外层字典的键仅使用了单独的日期（arr(i,1)），没有把小时维度（对应B列数据）纳入分组依据，导致同一天内所有小时的风向数据被合并到一起，丢失了小时层级的分组。

修正后的代码 #

Sub test()
    Dim arr, i&, d As Object, key, x, temp&, str$, res, m&
    Set d = CreateObject("scripting.dictionary")
    arr = Range("A1").CurrentRegion '读取A:C列的所有数据

    For i = 2 To UBound(arr)
        '生成日期+小时的组合键，确保同一日期小时的记录归为一组
        key = Format(arr(i, 1), "YYYY/MM/DD") & " " & arr(i, 2)
        If Not d.exists(key) Then Set d(key) = CreateObject("Scripting.dictionary")
        '统计该组内各风向的出现次数
        If arr(i, 3) <> "" Then d(key)(arr(i, 3)) = d(key)(arr(i, 3)) + 1
    Next
    
    '准备结果数组
    ReDim res(1 To d.Count + 1, 1 To 2): m = 1
    res(1, 1) = "Date & Time": res(1, 2) = "Prevailing Wind Direction"
    
    '遍历字典生成结果
    For Each key In d
        temp = 0: str = ""
        m = m + 1
        '找出该组内出现次数最多的风向（次数相同则用/分隔）
        For Each x In d(key)
           If d(key)(x) > temp Then
            temp = d(key)(x): str = x
           ElseIf d(key)(x) = temp Then
            str = str & "/" & x
           End If
        Next
        res(m, 1) = key: res(m, 2) = str
    Next
    
    '输出结果到I列开始的区域
    With Range("i1").Resize(m, 2)
        .CurrentRegion.ClearContents
        .NumberFormatLocal = "@"
        .Value = res
    End With
End Sub

关键改动说明 #

• 组合键生成：用Format(arr(i, 1), "YYYY/MM/DD") & " " & arr(i, 2)将日期和小时拼接成唯一的字符串键，保证同一日期+小时的记录被分到同一组。
• 输出保留组合信息：结果数组的第一列直接使用组合键，确保输出的是日期+小时的完整信息。
• 其余统计风向的逻辑保持不变，依然会找出每组内出现次数最多的风向，次数相同则合并显示。

内容的提问来源于stack exchange，提问作者Jerry Hsu