cslinmiso

回復 10# GBKEE


感謝版主再次回覆，小弟會試驗看看，遇錯再發問還請指教。

此外，小弟發現之前給的檔案格式有錯誤，試用正確格式的檔案，各位大哥的程式都跑不出來了。
欄位一切都一樣，但是就是跑不出來，我重做了一次表格內容也有更動，想請各位再次指點，謝謝。

Compa.rar (11.55 KB)

下載次數: 7

2012-10-2 10:00

-------
另外藉此機會順便問一下小弟寫的一個程式是否可以更簡潔，或者有更好的寫法。
謝謝

相信各位都應該看得懂，不過我還是大概解釋一下
此程式是取用Week  (週數)分析.XLS 該報表內的數據
先以某欄(mytype)篩選出各項後計數填入 另外一份報表Weekly Refund report letter.xls 之 D10欄位開始13個欄位
大概即是如此

1. Sub Macro8()
   
2. Dim mySubtotal As Double
   
3. Dim mytype As Variant
   
4. Dim Wkabc As Variant
   
5. Dim Wkvip As Variant
   
6. Dim myx, myi As Integer
   
7. Dim i As Integer
   
8. Dim searchTerm As String
   
9. Dim myArray(10) As String
   
10. 
    
11. Application.ScreenUpdating = False '關閉螢幕更新
    
12. 
    
13. Wkabc = Application.InputBox(prompt:="Please Input Current Week", Title:="Weekly Report Letter for ABC")
    
14.    Filename = "Week " & Wkabc & "分析" & ".XLS" 'report名稱更改週數
    
15. '搜尋開啟的report名稱
    
16.     For i = 1 To Workbooks.Count
    
17.        'Arr = Array(Workbooks(i).Name)
    
18.          myArray(i) = Workbooks(i).Name
    
19.             Next
    
20.     GoTo Search '搜尋開啟的report名稱
    
21.             
    
22. Search: 'find report name contains wkabc
    
23.        searchTerm = Wkabc & "分析"
    
24.     'Check if a value exists in the Array
    
25.     If UBound(Filter(myArray, searchTerm)) >= 0 And searchTerm <> "" Then
    
26.         GoTo Filter1
    
27.     Else
    
28.         MsgBox "找不到此報告，確認是否輸入正確並確認檔案已經開啟"
    
29.         '若找不到就停止
    
30.     GoTo Weeklyvip
    
31.     End If
    
32. 
    
33. Filter1:
    
34.     mytype = Array("Absent", "Client", "Computer", "Connection", "Consultant Shortage", "Disconnection", "Disconnection(Idle)", "Headset", "Instant Break (Disconnection)", "Other", "Power Outage", "System", "TE")
    
35. '計數myi 13 次
    
36.           For myi = 0 To 12
    
37. '定義MYX為陣列 mytpe + MYI次數(即位置)
    
38.           myx = (mytype(myi))
    
39. 
    
40. ' 'Filter
    
41.    Workbooks(Filename).Activate
    
42.    mySubtotal = D10
    
43.    Worksheets("分析").Range("$A$1:$J$250").AutoFilter Field:=9, Criteria1:=myx
    
44.     'Count range
    
45.     mySubtotal = Application.WorksheetFunction.Subtotal(3, Worksheets("分析").Range("B2:B250"))
    
46.          Windows("Weekly Refund report letter.xls").Activate
    
47.     Range("D" & myi + 10) = mySubtotal
    
48. 
    
49. Next myi
    
50.     Workbooks(Filename).Activate
    
51.     ActiveSheet.Range("$A$1:$J$250").AutoFilter Field:=9 '開回篩選ALL

複製代碼

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

複製代碼

cslinmiso

感謝GBKEE再次提點，試用後的確是執行正常。完美無缺。
真不知道小弟當時怎麼會一直執行後得到空白？

感謝您的修正，看見您將陣列改成for each，請問此種寫法是否比較直覺或者比較簡單呢？
小弟還是新手常常繞了一大圈。

今日還有寫了幾個還得勞駕各位看看，不過現在已經在家了，明天再勞煩各位。

再次感謝GBKEE版主以及Hsieh 超版.hugh0620 ^_^

hugh0620

回復 7# cslinmiso


    噗~ 我有下載你的檔案~ 執行後~ 並未有您說的問題耶~ 呵呵~

   不過沒關係~ 有G大跟H大~ 幫你解決了~ 你的問題~ ^^

   其實不管是G大大的寫法或是H大大的寫法
   這個要看個人的使用習慣~  您都可以參考看看~~

   不過要提醒的是~ 資料輸入時日期或是時間的格式~ 通常都會造成~
   兩個不同SHEET在比對時~ 無法將資料正確比對~

GBKEE

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

cslinmiso

回復 15# GBKEE

謝謝GBKEE版主提點，試用您的程式後正常。
想請問我原本的程式是比較不好還是會造成問題呢?

hugh0620 十分感謝您的幫助，我會吸收您的建議

感謝各位，今後有問題我想我應該直接接著這篇繼續問好了(如果相關的話)