字典配合split分裂填充

Sub 配送日报()
lastrow = Sheets("运营日报").Range("a1048576").End(xlUp).Row
arr = Sheets("运营日报").Range("a1:ab" & lastrow)
Set d = CreateObject("scripting.dictionary")
For a = 4 To lastrow
unite = arr(a, 1) & "|" & arr(a, 6) & "|" & arr(a, 26)
If Not d.exists(unite) Then
d.Add unite, ""
End If
Next

ReDim brr(1 To d.Count, 2)
i = 0
For Each k In d.keys
brr(i + 1, 0) = Split(k, "|")(0)
brr(i + 1, 1) = Split(k, "|")(1)
brr(i + 1, 2) = Split(k, "|")(2)
i = i + 1
Next
Sheets("配送日报表").Range("a3").Resize(UBound(brr), 3) = brr
d.RemoveAll

Call 基本信息录入

End Sub