arr = [m1].CurrentRegion '//数据 brr = [a1].CurrentRegion '//结果 For i = 2 To UBound(brr) '//遍历结果的数组元素 For j = 2 To UBound(brr, 2) For m = 2 To UBound(arr) '//遍历数据 If brr(i, 1) = arr(m, 1) And brr(1, j) = arr(m, 2) Then '//如果姓名和月份都是对应的 brr(i, j) = arr(m, 3) '//输出值 End If [a1].Resize(UBound(brr), UBound(brr, 2)) = brr End Sub arr = [m1].CurrentRegion '//数据 brr = [a1].CurrentRegion '//结果 Set d = CreateObject("scripting.dictionary") Set d1 = CreateObject("scripting.dictionary") For i = 2 To UBound(arr) '//遍历数据 Key = arr(i, 1) & arr(i, 2) '//key d(Key) = arr(i, 3) '//查询值 d(arr(i, 1)) = d(arr(i, 1)) + 1 '//对姓名计数,循环次数 d1(arr(i, 1) & d(arr(i, 1))) = arr(i, 2) '//月份 For i = 2 To UBound(brr) For j = 1 To d(brr(i, 1)) '//循环次数,姓名计数，减少循环次数 C = d1(brr(i, 1) & j) '//返回月份 brr(i, C + 1) = d(brr(i, 1) & C) '//查询数据 [a1].Resize(UBound(brr), UBound(brr, 2)) = brr End Sub

split+数组减少循环次数

Sub 秋月2()
    Dim arr, brr
    arr = [m1].CurrentRegion '//数据
    brr = [a1].CurrentRegion '//结果
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)  '//遍历数据
      d(arr(i, 1) & arr(i, 2)) = arr(i, 3)   '//查询
      d(arr(i, 1)) = d(arr(i, 1)) & "," & arr(i, 2)   '将月份用逗号链接起来
    For i = 2 To UBound(brr)
    s = Split(d(brr(i, 1)), ",")  '//拆解月份，用来遍历
        For j = 1 To UBound(s)  '//循环次数,数组第一个元素为 逗号
            brr(i, s(j) + 1) = d(brr(i, 1) & s(j))  '//查询数据
    [a1].Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub