Option Explicit
Sub abc()
Dim a, i, m, n, s, d(1), t(1)
a = [a1].CurrentRegion.Resize(, 4).Value
ReDim b(UBound(a), 1 To 2 + 30)
For i = 0 To UBound(d)
Set d(i) = CreateObject("scripting.dictionary")
Next
s = "酒水业绩"
n = 3: d(1)(s) = n: b(0, n) = s
For i = 2 To UBound(a)
t(0) = a(i, 1) & a(i, 2)
If Not d(0).exists(t(0)) Then
m = m + 1: d(0)(t(0)) = m
b(m, 1) = a(i, 1): b(m, 2) = a(i, 2)
End If
a(i, 3) = Replace(a(i, 3), "加", "+")
If InStr(a(i, 3), "开台费") Or InStr(a(i, 3), "+") Then
t(1) = s
Else
t(1) = a(i, 3)
If Not d(1).exists(t(1)) Then
n = n + 1: d(1)(t(1)) = n
b(0, n) = t(1)
End If
End If
b(d(0)(t(0)), d(1)(t(1))) = b(d(0)(t(0)), d(1)(t(1))) + a(i, 4)
Next
b(0, 1) = "订台人": b(0, 2) = "台位"
[f1].Resize(m + 1, n) = b
End Sub