12
返回列表 上一主題 發帖

[發問] 如何尋找相同資料並複製其他欄位

cslinmiso

帖子
13 
主題
1 
精華
0 
積分
18 
點名
0  
作業系統
Win7 
軟體版本
office 2007 
閱讀權限
10 
性別
男 
來自
Taipei 
註冊時間
2012-9-29 
最後登錄
2012-10-10 
11# 跳轉到 »
發表於 2012-10-2 11:25 | 只看該作者
回復 10# GBKEE


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

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

Compa.rar (11.55 KB)

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

相信各位都應該看得懂，不過我還是大概解釋一下
此程式是取用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

  11. Application.ScreenUpdating = False '關閉螢幕更新

  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

  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))

  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

  49. Next myi
  50.     Workbooks(Filename).Activate
  51.     ActiveSheet.Range("$A$1:$J$250").AutoFilter Field:=9 '開回篩選ALL
複製代碼
很多事情，開始做了之後才發現很簡單，
真正難的是怎麼完美地發揮自身的狀態。

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
12#
發表於 2012-10-2 13:41 | 只看該作者
回復 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

  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
複製代碼

TOP

cslinmiso

帖子
13 
主題
1 
精華
0 
積分
18 
點名
0  
作業系統
Win7 
軟體版本
office 2007 
閱讀權限
10 
性別
男 
來自
Taipei 
註冊時間
2012-9-29 
最後登錄
2012-10-10 
13#
發表於 2012-10-2 19:53 | 只看該作者
感謝GBKEE再次提點，試用後的確是執行正常。完美無缺。
真不知道小弟當時怎麼會一直執行後得到空白？

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

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

再次感謝GBKEE版主以及Hsieh 超版.hugh0620 ^_^
很多事情，開始做了之後才發現很簡單，
真正難的是怎麼完美地發揮自身的狀態。

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
14#
發表於 2012-10-2 20:39 | 只看該作者
本帖最後由 hugh0620 於 2012-10-2 21:03 編輯

回復 7# cslinmiso


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

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

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

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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
15#
發表於 2012-10-3 06:42 | 只看該作者
回復 13# cslinmiso
"將陣列改成for each，請問此種寫法是否比較直覺或者比較簡單呢？"
這端看個人的習慣而定

TOP

cslinmiso

帖子
13 
主題
1 
精華
0 
積分
18 
點名
0  
作業系統
Win7 
軟體版本
office 2007 
閱讀權限
10 
性別
男 
來自
Taipei 
註冊時間
2012-9-29 
最後登錄
2012-10-10 
16#
發表於 2012-10-4 16:09 | 只看該作者
回復 15# GBKEE

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

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

感謝各位，今後有問題我想我應該直接接著這篇繼續問好了(如果相關的話)
很多事情，開始做了之後才發現很簡單，
真正難的是怎麼完美地發揮自身的狀態。

TOP

        靜思自在 : 屋寬不如心寬。
12
返回列表 上一主題