Sub test同簿相同格式同一位置求和()
Dim r%, i%
Dim arr, brr, crr(1 To 100, 1 To 4)
Dim wb As Workbook
Dim ws As Worksheet
Dim mypath$, myname$
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Worksheets("汇总表")
.Range("G34:J35,Q34:T35,F37:AO38,B41:AO41,J43:AG44,B46:AO46,Z48:AO48").Select
.Range("G34:J35,Q34:T35,F37:AO38,B41:AO41,J43:AG44,B46:AO46,Z48:AO48,AB51:AC51,AK51:AM51").Select
Selection.ClearContents
.Range("G34").Select
arr = .UsedRange
v = "G34,Q34,G35,Q35,F37,J37,N37,R37,V37,Z37,AD37,AH37,AL37,F38"
v = v & ",J38,N38,R38,V38,Z38,AD38,AH38,AL38,B41,J41,R41,Z41,AH41"
v = v & ",J43,R43,Z43,J44,R44,Z44,B46,J46,R46,Z46,AH46,Z48,AH48"
v = v & ",AB51,AK51"
v = Split(v, ",")
End With
m = 0
For Each ws In Worksheets '循环工作簿中工作表
If ws.Name <> "汇总表" Then
With ws
brr = .UsedRange
For i = 1 To UBound(v) + 1
r = Range(v(i - 1)).Row: c = Range(v(i - 1)).Column
arr(r, c) = arr(r, c) + .Range(v(i - 1))
Next
End With
End If
Next
With Worksheets("汇总表")
.UsedRange = arr
End With
MsgBox "数据汇总完成!"
End Sub |