|
Sub huizong()
Set d = CreateObject("scripting.dictionary")
With Sheets("TOTAL")
rs = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("a3:y" & rs) = Empty
ar = .Range("a1:y10000")
For j = 2 To UBound(ar, 2) Step 2
If Trim(ar(1, j)) <> "" Then
d(Trim(ar(1, j))) = j
End If
Next j
k = 2
For Each sh In Sheets
If sh.Name <> "TOTAL" Then
br = sh.[a1].CurrentRegion
For i = 2 To UBound(br)
If Trim(br(i, 1)) <> "" And InStr(br(i, 1), "合计") = 0 Then
t = d(Trim(br(i, 1)))
If t = "" Then
k = k + 1
d(Trim(br(i, 1))) = k
t = k
ar(k, 1) = br(i, 1)
End If
m = d(Trim(br(i, 2)))
If m <> "" Then
ar(t, m) = ar(t, m) + br(i, 7)
ar(t, m + 1) = ar(t, m + 1) + br(i, 13)
End If
End If
Next i
End If
Next sh
.Range("a1").Resize(k, UBound(ar, 2)) = ar
.Cells(k + 1, 1) = "合计:"
For j = 2 To UBound(ar, 2)
.Cells(k + 1, j) = Application.Sum(.Range(.Cells(3, j), .Cells(k + 2, j)))
Next j
ReDim cr(1 To 13, 1 To 3)
m = 1
cr(m, 1) = "月份"
cr(m, 2) = "应付金额"
cr(m, 3) = "未付金额"
For j = 2 To UBound(ar, 2) Step 2
m = m + 1
cr(m, 1) = ar(1, j)
yf = 0: wf = 0
For i = 3 To k
yf = yf + ar(i, j)
wf = wf + ar(i, j + 1)
Next i
cr(m, 2) = yf
cr(m, 3) = wf
Next j
.Cells(k + 3, 1).Resize(m, 3) = cr
End With
MsgBox "ok!"
End Sub
|
|