|
楼主 |
发表于 2020-9-28 19:15
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
谢谢褚老师提供的代码
Sub test()
Dim r%, i%
Dim arr, brr(1 To 2)
Dim ws As Worksheet
Dim d As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d = CreateObject("scripting.dictionary")
n = 0
For Each ws In Worksheets
If ws.Name Like "*月" Then
With ws
r = .Cells(.Rows.Count, 2).End(xlUp).Row
arr = .Range("a3:h" & r)
For i = 1 To UBound(arr)
If Not d.exists(arr(i, 2)) Then
n = n + 1
d(arr(i, 2)) = n
End If
Next
End With
End If
Next
ReDim crr(1 To 12, 1 To d.Count)
For k = 1 To 2
brr(k) = crr
Next
For Each ws In Worksheets
If ws.Name Like "*月" Then
m = Val(ws.Name)
With ws
r = .Cells(.Rows.Count, 2).End(xlUp).Row
arr = .Range("a3:h" & r)
For i = 1 To UBound(arr)
n = d(arr(i, 2))
brr(1)(m, n) = brr(1)(m, n) + arr(i, 6)
brr(2)(m, n) = brr(2)(m, n) + arr(i, 7)
Next
End With
End If
Next
For k = 1 To 2
With Worksheets(IIf(k = 1, "2020年总数量", "2020年总货款"))
.Cells.Clear
.Range("a2") = "月份"
.Range("b2").Resize(1, d.Count) = d.keys
.Range("a3").Resize(13, 1) = Application.Transpose(Array("1月", "2月", "3月", "4月", "5月", "6月", "7月", "8月", "9月", "10月", "11月", "12月", "合计"))
.Range("b3").Resize(UBound(brr(k)), UBound(brr(k), 2)) = brr(k)
.Range("b15").Resize(1, UBound(brr(k), 2)).FormulaR1C1 = "=SUM(R3C:R[-1]C)"
With .Range("a2").Resize(UBound(brr(k)) + 2, UBound(brr(k), 2) + 1)
.Borders.LineStyle = xlContinuous
With .Font
.Name = "微软雅黑"
.Size = 11
End With
End With
.Columns(1).Resize(, UBound(brr(k), 2) + 1).AutoFit
With .UsedRange
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End With
Next
End Sub
|
|