[發問] 關於WorksheetFunction.match的使用方法?

l020330320

不好意思 各位前輩 最近小弟在工作上剛好有使用到EXCEL的VBA
但是恰好碰到一些問題實在搞不懂 所以上來發問請求指點!!

1.本來是使用 Find 方法來尋找相符的資料並用 FindNext 來尋找下一筆，但發現資料量一大之後電腦的執行速度實在慢到有點誇張(2000筆資料需要20秒左右)，故改寫了Match的方法。
2.Match方法支援的資料型態是哪種呢?因為小弟使用string型態來執行(也嘗試過Variant一樣會錯)，發現部分的資料匯入是行得通的(EX:21040523007)這筆可以，但有部分資料卻跳出錯誤1004 無法取得類別worksheetFunction 的 Match 屬性(EX:21040508010)這筆，有點疑惑，因為都是用同一判斷方式，怎麼會有多種不同的結果。
3.Match的尋找下一筆的語法小弟去MSDN看過，可是不是很了解，上面只寫了 "match = match.NextMatch()  " 可是我把它變數轉換帶進去後，跳出錯誤 不正確的定位項(qualifier)。

以上三個問題真的很頭疼，在此附上檔案附件以及代碼麻煩各位前輩指引一下，感激不盡。

※CODE的位置在"登錄"此工作表內的"輸入號碼"的位置

1. Private Sub CommandButton4_Click() '輸入工卡號碼
   
2. 
   
3. Dim a As String, cardnumber As String
   
4. 
   
5. Application.ScreenUpdating = False
   
6. 
   
7. cardnumber = InputBox("請輸入工卡號碼(建議使用條碼器)")
   
8. i = 9
   
9. 
   
10. Sheets("資料庫").Activate
    
11. 
    
12. a = Application.WorksheetFunction.Match(CDbl(cardnumber), Sheets("資料庫").[B:B], 0) '設定資料庫裡的B欄搜尋結果為a
    
13. If a = "0" Then
    
14.     MsgBox "未搜尋到您所輸入的工卡號碼，請確認資料來源無誤。"
    
15.     Sheets("登錄").Select
    
16.     Exit Sub
    
17. Else
    
18.     Sheets("登錄").Range("A2") = cardnumber
    
19.     firstAddress = Cells(a, 2).Address
    
20.                   
    
21.     Do
    
22.         Sheets("資料庫").Select
    
23.         ActiveSheet.Range(ActiveSheet.Cells(a, 1), ActiveSheet.Cells(a, 62)).Select '選擇並複製欄位
    
24.         Selection.Copy
    
25.    
    
26.         Sheets("登錄").Select
    
27.             '如果判定B欄C欄及K欄都為空值的話則貼上
    
28.             If (ActiveSheet.Cells(i, 2) = "" And ActiveSheet.Cells(i, 3) = "" And ActiveSheet.Cells(i, 6) = "") Then
    
29.             ActiveSheet.Cells(i, 2).Select
    
30.             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
31.             Application.CutCopyMode = False
    
32.         
    
33.             Sheets("資料庫").Select
    
34.         
    
35.             'a = a.Nextmatch()
    
36.             secondAddress = Cells(a, 2).Address '判斷ADDRESS後選取複製欄位
    
37.             Else
    
38.             End If
    
39.         i = i + 1
    
40.            
    
41.     Loop While secondAddress <> firstAddress
    
42.     Sheets("登錄").Select
    
43.    
    
44. End If
    
45. 
    
46. Range("K9") = "=G7"
    
47. Range("K10") = "=H7"
    
48. Range("K11") = "=I7"
    
49. Range("K12") = "=J7"
    
50. Range("K13") = "=K7"
    
51. Range("K14") = "=L7"
    
52. Range("K15") = "=M7"
    
53. Range("K16") = "=N7"
    
54. Range("K17") = "=O7"
    
55. Range("K18") = "=P7"
    
56. 
    
57. 
    
58. Application.ScreenUpdating = True
    
59. End Sub

複製代碼

TEST.rar (78.67 KB)

下載次數: 8

2015-6-30 14:44

lpk187

回復 1# l020330320

搜尋速度要快可以利用陣列來找速度會快很多的！下面代碼給你參考！

1. Private Sub CommandButton4_Click() '輸入工卡號碼
   
2. Dim a As String, cardnumber As String
   
3. Dim arr2()
   
4. Application.ScreenUpdating = False
   
5. cardnumber = InputBox("請輸入工卡號碼(建議使用條碼器)")
   
6. i = 9
   
7. x = 1
   
8. arr = Sheets("資料庫").Range("a2:bj" & Sheets("資料庫").Cells(Rows.Count, 2).End(xlUp).Row)
   
9. 
   
10. For j = 1 To UBound(arr, 1)
    
11.     If arr(j, 2) = cardnumber Then
    
12.         ReDim Preserve arr2(1 To 42, 1 To x)
    
13.         arr1 = Application.Transpose(Application.Index(arr, j, 0))
    
14.         For s = 1 To 42
    
15.             arr2(s, x) = Application.Transpose(arr1(s, 1))
    
16.         Next
    
17.         x = x + 1
    
18.     End If
    
19. Next
    
20. [a2] = cardnumber
    
21. [b9].Resize(UBound(arr2, 2), UBound(arr2, 1)) = Application.Transpose(arr2)
    
22. 'Sheets("資料庫").Activate
    
23. 
    
24. 'a = Application.WorksheetFunction.Match(CDbl(cardnumber), Sheets("資料庫").[B:B], 0) '設定資料庫裡的B欄搜尋結果為a
    
25. 'If a = "0" Then
    
26. '    MsgBox "未搜尋到您所輸入的工卡號碼，請確認資料來源無誤。"
    
27. '    Sheets("登錄").Select
    
28. '    Exit Sub
    
29. 'Else
    
30. '    Sheets("登錄").Range("A2") = cardnumber
    
31. '    firstAddress = Cells(a, 2).Address
    
32. '
    
33. '    Do
    
34. '        Sheets("資料庫").Select
    
35. '        ActiveSheet.Range(ActiveSheet.Cells(a, 1), ActiveSheet.Cells(a, 62)).Select '選擇並複製欄位
    
36. '        Selection.Copy
    
37. '
    
38. '        Sheets("登錄").Select
    
39. '            '如果判定B欄C欄及K欄都為空值的話則貼上
    
40. '            If (ActiveSheet.Cells(i, 2) = "" And ActiveSheet.Cells(i, 3) = "" And ActiveSheet.Cells(i, 6) = "") Then
    
41. '            ActiveSheet.Cells(i, 2).Select
    
42. '            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
43. '            Application.CutCopyMode = False
    
44. '
    
45. '            Sheets("資料庫").Select
    
46. '
    
47. '            'a = a.Nextmatch()
    
48. '            secondAddress = Cells(a, 2).Address '判斷ADDRESS後選取複製欄位
    
49. '            Else
    
50. '            End If
    
51. '        i = i + 1
    
52. '
    
53. '    Loop While secondAddress <> firstAddress
    
54. '    Sheets("登錄").Select
    
55. '
    
56. 'End If
    
57. Range("K9") = "=G7"
    
58. Range("K10") = "=H7"
    
59. Range("K11") = "=I7"
    
60. Range("K12") = "=J7"
    
61. Range("K13") = "=K7"
    
62. Range("K14") = "=L7"
    
63. Range("K15") = "=M7"
    
64. Range("K16") = "=N7"
    
65. Range("K17") = "=O7"
    
66. Range("K18") = "=P7"
    
67. Application.ScreenUpdating = True
    
68. End Sub

複製代碼

GBKEE

回復 1# l020330320

http://forum.twbts.com/viewthread.php?tid=10339

l020330320

回復 2# lpk187

好的，謝謝L大的提點，我也正在想如果沒辦法搞定，再換個方式寫看看!!

l020330320

回復 3# GBKEE

G大謝謝囉，原來常常發生錯誤找不到match的值?可是明明表單裡面有那個值阿...怎麼還是會找不到呢?

GBKEE

回復 5# l020330320

下載 (59.43 KB)

2015-7-1 15:38

自己改一下 儲存格 是文字格式 , CDbl 格式為 Double 數字
   

1. Sheets("資料庫").Activate
   
2.         'CDbl(cardnumber)
   
3. a = Application.Match(cardnumber, Sheets("資料庫").[B:B], 0) '設定資料庫裡的B欄搜尋結果為a

複製代碼

l020330320

回復 6# GBKEE

感謝，因為office沒有顯示綠色標籤提醒，居然忘記了最原始儲存格格式的問題。難怪問題寥寥....感謝指導~!!