|
|
Sub 汇总()
Application.ScreenUpdating = False
Dim ar As Variant
Dim br()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
f = Dir(ThisWorkbook.Path & "\学生食材出库明细表\*.xls*")
ReDim br(1 To 500, 1 To 150)
br(1, 1) = "日期"
br(1, 2) = "星期"
k = 2: y = 2
Do While f <> ""
Set wb = Workbooks.Open(ThisWorkbook.Path & "\学生食材出库明细表\" & f, 0)
With wb.Worksheets(1)
r = .Cells(Rows.Count, 1).End(xlUp).Row
ar = .Range("a2:o" & r)
End With
wb.Close False
For i = 2 To UBound(ar)
If ar(i, 4) <> "" And ar(i, 6) <> "" Then
If ar(i, 4) <> "合计" Then
If IsDate(ar(i, 6)) Then
t = d(ar(i, 6))
If t = "" Then
k = k + 1
d(ar(i, 6)) = k
t = k
br(k, 1) = ar(i, 6)
br(k, 2) = Weekday(ar(i, 6), 2)
End If
lh = d(ar(i, 4))
If lh = "" Then
y = y + 3
d(ar(i, 4)) = y
lh = y
br(1, y - 2) = ar(i, 4)
br(2, y - 2) = "数量"
br(2, y - 1) = "单价"
br(2, y) = "金额"
End If
br(t, lh - 2) = br(t, lh - 2) + ar(i, 10)
br(t, lh) = br(t, lh) + ar(i, 13)
br(t, lh - 1) = ar(i, 11)
End If
End If
End If
Next i
f = Dir
Loop
br(1, y + 1) = "金额合计"
For i = 3 To k
hj = 0
For j = 5 To y Step 3
hj = hj + br(i, j)
Next j
br(i, y + 1) = hj
Next i
With Sheet1
.UsedRange.Borders.LineStyle = 0
.UsedRange.ClearContents
.[a1].Resize(k, y + 1) = br
h = k + 1
.Cells(h, 1) = "合计"
For j = 3 To y
.Cells(h, j) = Application.Sum(.Range(.Cells(3, j), .Cells(k, j)))
Next j
.[a1].Resize(k + 1, y + 1).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-12-31 16:54
楼主
