- 帖子
- 1572
- 主題
- 16
- 精華
- 2
- 積分
- 1521
- 點名
- 0
- 作業系統
- xp
- 軟體版本
- office 2003
- 閱讀權限
- 150
- 性別
- 男
- 註冊時間
- 2010-5-1
- 最後登錄
- 2016-1-13
|
3#
發表於 2011-8-12 21:45
| 只看該作者
- Sub yy()
- Dim n%, i%, j%, m%, arr, arr2(), b()
- ActiveSheet.UsedRange.Offset(2, 0) = ""
- Application.ScreenUpdating = False
- Workbooks.Open Filename:=ThisWorkbook.Path & "\" & [a1] & ".xls"
- With ActiveSheet
- n = .[a65536].End(xlUp).Row
- arr = .Range(.[a1], .Cells(n, 5))
- ReDim arr2(1 To 5, 1 To UBound(arr))
- End With
- ActiveWorkbook.Close True
- Set d = CreateObject("scripting.dictionary")
- For i = 1 To n
- If i = 1 Then x = "總計" Else x = arr(i, 4) - arr(i, 5)
- b = Array(arr(i, 1), arr(i, 2), arr(i, 4), arr(i, 5), x)
- If Not d.exists(arr(i, 1)) Then
- m = m + 1
- d(arr(i, 1)) = m
- For j = 1 To 5
- arr2(j, m) = b(j - 1)
- Next
- Else
- For j = 3 To 5
- arr2(j, d(arr(i, 1))) = arr2(j, d(arr(i, 1))) + arr(i, j)
- Next
- End If
- Next
- [a3].Resize(m, 5) = Application.Transpose(arr2)
- Application.ScreenUpdating = True
- End Sub
|
|
發表於 2011-8-12 19:38
| 
