|
Option Explicit
Sub test()
Dim ar, br, i&, j&, r&, dic As Object, vKey
Set dic = CreateObject("Scripting.Dictionary")
ar = [J1].CurrentRegion
For i = 2 To UBound(ar)
vKey = ar(i, 1)
If Not dic.exists(vKey) Then
dic(vKey) = Array(ar(i, 7), ar(i, 9))
Else
dic(vKey) = Array(dic(vKey)(0) + ar(i, 7), dic(vKey)(1) + ar(i, 9))
End If
Next i
For Each vKey In dic.keys
r = 0
ReDim br(1 To UBound(ar) + 3, 1 To UBound(ar, 2) - 1)
For i = 2 To UBound(ar)
If ar(i, 1) = vKey Then
r = r + 1
For j = 1 To UBound(br, 2)
br(r, j) = ar(i, j)
Next j
End If
Next i
br(r + 1, 2) = "车费": br(r + 1, 6) = "=": br(r + 1, 7) = dic(vKey)(1)
br(r + 3, 7) = "合计": br(r + 3, 8) = dic(vKey)(0) + dic(vKey)(1)
[A7:H30].Clear
[A8].Resize(r + 3, UBound(br, 2)) = br
Range("A1", Cells(Rows.Count, "H").End(3)).ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & vKey
Next
Set dic = Nothing
Beep
End Sub
|
|