|
|
Sub 汇总()
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("汇总")
yf = .[a1]
If yf = "" Then MsgBox "请输入月份！": End
.UsedRange.Offset(2) = Empty
arr = .Range("a1:l10000")
For j = 2 To UBound(arr, 2) Step 4
arr(1, j + 1) = arr(1, j)
arr(1, j + 2) = arr(1, j)
Next j
For j = 2 To UBound(arr, 2) Step 1
If Trim(arr(1, j)) <> "" And Trim(arr(2, j)) <> "" Then
zd = Trim(arr(1, j)) & "|" & Trim(arr(2, j))
d(zd) = j
End If
Next j
k = 2
For Each sh In Sheets
If sh.Index > 1 Then
r = sh.Cells(Rows.Count, 1).End(xlUp).Row
ar = sh.Range("a1:e" & r)
For i = 2 To UBound(ar)
If InStr(ar(i, 1), "月") = 0 Then
ar(i, 5) = ar(i, 1)
End If
If ar(i, 5) = "" Then ar(i, 5) = ar(i - 1, 5)
If Trim(ar(i, 1)) = yf Then
t = d(Trim(ar(i, 5)))
If t = "" Then
k = k + 1
d(Trim(ar(i, 5))) = k
t = k
arr(k, 1) = ar(i, 5)
End If
For j = 2 To 4
zd = Trim(ar(1, j)) & "|" & Trim(sh.Name)
lh = d(zd)
If lh <> "" Then
arr(t, lh) = arr(t, lh) + ar(i, j)
End If
Next j
End If
Next i
End If
Next sh
.[a1].Resize(k, UBound(arr, 2)) = arr
End With
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2022-12-14 19:57
楼主
