oobird

1. Sub yy()
   
2.     Dim n%, i%, j%, m%, arr, arr2(), b()
   
3.     ActiveSheet.UsedRange.Offset(2, 0) = ""
   
4.     Application.ScreenUpdating = False
   
5.     Workbooks.Open Filename:=ThisWorkbook.Path & "\" & [a1] & ".xls"
   
6.     With ActiveSheet
   
7.         n = .[a65536].End(xlUp).Row
   
8.         arr = .Range(.[a1], .Cells(n, 5))
   
9.         ReDim arr2(1 To 5, 1 To UBound(arr))
   
10.     End With
    
11.     ActiveWorkbook.Close True
    
12.     Set d = CreateObject("scripting.dictionary")
    
13.     For i = 1 To n
    
14.         If i = 1 Then x = "總計" Else x = arr(i, 4) - arr(i, 5)
    
15.         b = Array(arr(i, 1), arr(i, 2), arr(i, 4), arr(i, 5), x)
    
16.         If Not d.exists(arr(i, 1)) Then
    
17.             m = m + 1
    
18.             d(arr(i, 1)) = m
    
19.             For j = 1 To 5
    
20.                 arr2(j, m) = b(j - 1)
    
21.             Next
    
22.         Else
    
23.             For j = 3 To 5
    
24.                 arr2(j, d(arr(i, 1))) = arr2(j, d(arr(i, 1))) + arr(i, j)
    
25.             Next
    
26.         End If
    
27.     Next
    
28.     [a3].Resize(m, 5) = Application.Transpose(arr2)
    
29.     Application.ScreenUpdating = True
    
30. End Sub

複製代碼

下載 (16.22 KB)

2011-8-12 21:45

oobird

喔，讓我有點疑惑,因為超級版主
寫的那會有問題,沒關係，哈哈！在下想請教，是哪裡會有問題？
說出來也好讓我學習學習。

oobird

Workbooks.Open Filename:=ThisWorkbook.Path & "\" & [a1] & ".xls"
    With ActiveSheet
        n = .[a65536].End(xlUp).Row
        arr = .Range(.[a1], .Cells(n, 5))
執行到這一句時，已把所有數據存在陣列記憶中了，之後的存取都在這個陣列中
打開的活頁簿已經用不著就可以關閉了。
你要移到後面再關也隨你了。不可能移到後面去程式才會ok的。