|
楼主 |
发表于 2018-3-5 13:30
|
显示全部楼层
建议将两段代码对比着看:
- Sub 一键汇总()
- Dim myPath$, f$, wb As Workbook, sh As Worksheet
- Dim d As Object, temp, Arr(), n%, i%, j%, x%, S$
- Dim m1, m2, m3, m4
- Set d = CreateObject("Scripting.Dictionary")
- myPath = ThisWorkbook.Path & ""
- f = Dir(myPath & "*.xls*")
- Do While f <> ""
- If f <> ThisWorkbook.Name Then
- Set wb = Workbooks.Open(myPath & f)
- For Each sh In wb.Worksheets
- temp = sh.UsedRange
- For i = 2 To UBound(temp)
- S = temp(i, 1) & "|" & temp(i, 2) & "|" & temp(i, 3) & "|" & temp(i, 5) '判断条件
- If Not d.Exists(S) Then
- n = n + 1: ReDim Preserve Arr(1 To 8, 1 To n)
- d(S) = n
- For j = 1 To 8
- Arr(j, n) = temp(i, j)
- Next
- Else
- x = d.Item(S)
- Arr(4, x) = Arr(4, x) + temp(i, 4) '工时
- Arr(6, x) = Arr(6, x) + temp(i, 6) '基本
- Arr(7, x) = Arr(7, x) + temp(i, 7) '工时单价
- Arr(8, x) = Arr(8, x) + temp(i, 8) '工时工资
- End If
- m1 = m1 + temp(i, 4) '工时累计
- m2 = m2 + temp(i, 6) '基本累计
- m3 = m3 + temp(i, 7) '工时单价累计
- m4 = m4 + temp(i, 8) '工时工资累计
- Next
- Next
- wb.Close False
- End If
- f = Dir
- Loop
- Application.ScreenUpdating = False
- Range("A2:H65536").Clear
- If n > 0 Then
- Range("A2").Resize(n, 8) = WorksheetFunction.Transpose(Arr)
- Range("A" & n + 2) = "合计"
- Range("B" & n + 2) = "人"
- Range("D" & n + 2) = m1
- Range("F" & n + 2) = m2
- Range("G" & n + 2) = m3
- Range("H" & n + 2) = m4
- Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
- End If
- Application.ScreenUpdating = True
- Set sh = Nothing
- Set wb = Nothing
- Set d = Nothing
- End Sub
复制代码 |
|