GBKEE

回復 1# cslinmiso
使用Dictionary物件

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim d As Object, Rng As Range
   
4.     Set d = CreateObject("SCRIPTING.DICTIONARY")  '設立 Dictionary物件
   
5.     Set Rng = Sheets("sheet1").[a2]
   
6.     Do
   
7.         d(Format(Rng, "yyyy/m/d") & Format(Rng.Offset(, 1), "hh:mm") & Rng.Offset(, 2)) = Rng.Offset(, 3).Resize(, 3)
   
8.         '2012/9/2200:30Aaron        -> Dictionary物件的 key: Format(Rng, "yyyy/m/d") & Format(Rng.Offset(, 1), "hh:mm") & Rng.Offset(, 2)
   
9.         'Rng.Offset(, 3).Resize(, 3)-> Dictionary物件的 item (D:E:F欄)
   
10.         Set Rng = Rng.Offset(1)                   '變數物件 下移一列
    
11.     Loop Until Rng.Value = ""                     '變數物件內容=空白字串離開迴圈
    
12.     Set Rng = Sheets("sheet2").[a2]
    
13.     Do
    
14.         If d.Exists(Rng.Text & Rng.Offset(, 1).Text & Rng.Offset(, 2)) Then
    
15.             'Exists 方法 如果在 Dictionary 物件中指定的關鍵字存在，傳回 True，若不存在，傳回 False。
    
16.             Rng.Offset(, 3).Resize(, 3).Value = d(Rng & Rng.Offset(, 1).Text & Rng.Offset(, 2))
    
17.              'D:F欄.Value=Dictionary物件的item
    
18.         End If
    
19.         Set Rng = Rng.Offset(1)
    
20.     Loop Until Rng = ""
    
21. End Sub

複製代碼

GBKEE

回復 7# cslinmiso
"是否將    Set Rng = Sheets("sheet1").[a2] 此行  定義成worksheet.sheet("檔名").[a2] 即可呢?"
你試試就知道

GBKEE

回復 11# cslinmiso
附檔 可依 5# 及 6#  Hsieh 超版 的程式 得到
只是  6#  Hsieh 超版 的程式 修改  With  工作表1  -> With Sheets("sheet1") ' 工作表1
                                                            With  工作表2  -> With Sheets("sheet2") ' 工作表2
另修改 11# 的程式碼 試試看 是否合用?

1. Option Explicit
   
2. Sub Macro8()
   
3. Dim mySubtotal As Double
   
4. Dim mytype As Variant
   
5. Dim Wkabc As Variant
   
6. Dim Wkvip As Variant
   
7. Dim myx, myi As Integer
   
8. Dim i As Integer
   
9. Dim searchTerm As String
   
10. Dim myArray(10) As String
    
11. 
    
12. Dim Filename, Wo As Workbook, Filename_Msg As Boolean
    
13. Application.ScreenUpdating = False '關閉螢幕更新
    
14. Wkabc = Application.InputBox(prompt:="Please Input Current Week", Title:="Weekly Report Letter for ABC")
    
15. Filename = "Week " & Wkabc & "分析" & ".XLS" 'report名稱更改週數
    
16. '搜尋開啟的report名稱
    
17.     For Each Wo In Workbooks
    
18.          If Wo.Name = Filename Then
    
19.             Filename_Msg = True
    
20.             Exit For
    
21.          End If
    
22.     Next
    
23.     If Filename_Msg = False Then
    
24.         MsgBox "找不到此報告，確認是否輸入正確並確認檔案已經開啟"
    
25.         Exit Sub
    
26.     End If
    
27.      
    
28. Filter1:
    
29.     mytype = Array("Absent", "Client", "Computer", "Connection", "Consultant Shortage", "Disconnection", "Disconnection(Idle)", "Headset", "Instant Break (Disconnection)", "Other", "Power Outage", "System", "TE")
    
30.     For myi = 0 To 12 '計數myi 13 次
    
31. ' 'Filter
    
32.         Workbooks(Filename).Activate
    
33.         'mySubtotal = D10      '錯誤 沒有設立變數
    
34.         Worksheets("分析").Range("$A$1:$J$250").AutoFilter Field:=9, Criteria1:=mytype(myi)
    
35.             'Count range
    
36.         mySubtotal = Application.WorksheetFunction.Subtotal(3, Worksheets("分析").Range("B2:B250"))
    
37.         Windows("Weekly Refund report letter.xls").Activate
    
38.         Range("D" & myi + 10) = mySubtotal
    
39.     Next myi
    
40.     Workbooks(Filename).Activate
    
41.     ActiveSheet.Range("$A$1:$J$250").AutoFilter Field:=9 '開回篩選ALL
    
42. End Sub

複製代碼

GBKEE

回復 13# cslinmiso
"將陣列改成for each，請問此種寫法是否比較直覺或者比較簡單呢？"
這端看個人的習慣而定