Sub 对账单()
Dim ar As Variant
Dim i As Long
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim br()
ar = Sheets("开湖(水沟)").[a1].CurrentRegion
ReDim br(1 To UBound(ar), 1 To 17)
For i = 2 To UBound(ar)
If Trim(ar(i, 1)) <> "" And Trim(ar(i, 5)) <> "" And Trim(ar(i, 6)) <> "" And Trim(ar(i, 8)) <> "" Then
zf = ar(i, 1) & "|" & Trim(ar(i, 5)) & "|" & Trim(ar(i, 6)) & "|" & Trim(ar(i, 8))
t = d(zf)
If t = "" Then
k = k + 1
d(zf) = k
t = k
br(k, 1) = k
br(k, 2) = ar(i, 1)
br(k, 3) = ar(i, 8)
br(k, 4) = ar(i, 9)
End If
br(t, 5) = br(t, 5) + 1
br(t, 6) = br(t, 6) + ar(i, 11)
br(t, 10) = br(t, 10) + ar(i, 31)
br(t, 11) = br(t, 10) * 35
br(t, 14) = br(t, 14) + ar(i, 34)
If ar(i, 34) > 0 Then
If br(t, 17) = "" Then
br(t, 17) = ar(i, 2)
Else
br(t, 17) = br(t, 17) & "," & ar(i, 2)
End If
End If
End If
Next i
If k = "" Then Exit Sub
With Sheets("对账表")
.Range("a8:q25") = Empty
.[a8].Resize(k, UBound(br, 2)) = br
End With
MsgBox "ok!"
End Sub
|