Option Explicit Sub 按比例分配数据() Dim a, i, j, d, t, n, ave a = [a1].CurrentRegion.Offset(2).Resize(, 7).Value Set d = CreateObject("scripting.dictionary") t = a(UBound(a) - 2, 7) - a(1, 5) ReDim b(UBound(a) - 2, 1 To t / 30 + 5) For i = a(1, 5) To a(UBound(a) - 2, 7) t = Format(i, "yyyy") & "月" & Format(i, "mm") & "月" If Not d.exists(t) Then n = n + 1: b(0, n) = t: d(t) = n Next For i = 1 To UBound(a) - 2 ave = a(i, 4) / a(i, 6) For j = a(i, 5) + 1 To a(i, 7) t = Format(j, "yyyy") & "月" & Format(j, "mm") & "月" b(i, d(t)) = b(i, d(t)) + ave Next Next [h2].Resize(UBound(b) + 1, n + 2) = b End Sub