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

不好意思各位前輩最近小弟在工作上剛好有使用到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的位置在"登錄"此工作表內的"輸入號碼"的位置

Private Sub CommandButton4_Click() '輸入工卡號碼
Dim a As String, cardnumber As String
Application.ScreenUpdating = False
cardnumber = InputBox("請輸入工卡號碼(建議使用條碼器)")
i = 9
Sheets("資料庫").Activate
a = Application.WorksheetFunction.Match(CDbl(cardnumber), Sheets("資料庫").[B:B], 0) '設定資料庫裡的B欄搜尋結果為a
If a = "0" Then
MsgBox "未搜尋到您所輸入的工卡號碼，請確認資料來源無誤。"
Sheets("登錄").Select
Exit Sub
Else
Sheets("登錄").Range("A2") = cardnumber
firstAddress = Cells(a, 2).Address
Do
Sheets("資料庫").Select
ActiveSheet.Range(ActiveSheet.Cells(a, 1), ActiveSheet.Cells(a, 62)).Select '選擇並複製欄位
Selection.Copy
Sheets("登錄").Select
'如果判定B欄C欄及K欄都為空值的話則貼上
If (ActiveSheet.Cells(i, 2) = "" And ActiveSheet.Cells(i, 3) = "" And ActiveSheet.Cells(i, 6) = "") Then
ActiveSheet.Cells(i, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("資料庫").Select
'a = a.Nextmatch()
secondAddress = Cells(a, 2).Address '判斷ADDRESS後選取複製欄位
Else
End If
i = i + 1
Loop While secondAddress <> firstAddress
Sheets("登錄").Select
End If
Range("K9") = "=G7"
Range("K10") = "=H7"
Range("K11") = "=I7"
Range("K12") = "=J7"
Range("K13") = "=K7"
Range("K14") = "=L7"
Range("K15") = "=M7"
Range("K16") = "=N7"
Range("K17") = "=O7"
Range("K18") = "=P7"
Application.ScreenUpdating = True
End Sub

複製代碼

TEST.rar (78.67 KB)

lpk187

高中生 Rank: 3 Rank: 3

帖子: 552
主題: 3
精華: 0
積分: 578
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2015-2-8
最後登錄: 2024-2-26

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

2^#

發表於 2015-6-30 19:30 | 只看該作者

回復 1# l020330320

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

Private Sub CommandButton4_Click() '輸入工卡號碼
Dim a As String, cardnumber As String
Dim arr2()
Application.ScreenUpdating = False
cardnumber = InputBox("請輸入工卡號碼(建議使用條碼器)")
i = 9
x = 1
arr = Sheets("資料庫").Range("a2:bj" & Sheets("資料庫").Cells(Rows.Count, 2).End(xlUp).Row)
For j = 1 To UBound(arr, 1)
If arr(j, 2) = cardnumber Then
ReDim Preserve arr2(1 To 42, 1 To x)
arr1 = Application.Transpose(Application.Index(arr, j, 0))
For s = 1 To 42
arr2(s, x) = Application.Transpose(arr1(s, 1))
Next
x = x + 1
End If
Next
[a2] = cardnumber
[b9].Resize(UBound(arr2, 2), UBound(arr2, 1)) = Application.Transpose(arr2)
'Sheets("資料庫").Activate
'a = Application.WorksheetFunction.Match(CDbl(cardnumber), Sheets("資料庫").[B:B], 0) '設定資料庫裡的B欄搜尋結果為a
'If a = "0" Then
' MsgBox "未搜尋到您所輸入的工卡號碼，請確認資料來源無誤。"
' Sheets("登錄").Select
' Exit Sub
'Else
' Sheets("登錄").Range("A2") = cardnumber
' firstAddress = Cells(a, 2).Address
'
' Do
' Sheets("資料庫").Select
' ActiveSheet.Range(ActiveSheet.Cells(a, 1), ActiveSheet.Cells(a, 62)).Select '選擇並複製欄位
' Selection.Copy
'
' Sheets("登錄").Select
' '如果判定B欄C欄及K欄都為空值的話則貼上
' If (ActiveSheet.Cells(i, 2) = "" And ActiveSheet.Cells(i, 3) = "" And ActiveSheet.Cells(i, 6) = "") Then
' ActiveSheet.Cells(i, 2).Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' Application.CutCopyMode = False
'
' Sheets("資料庫").Select
'
' 'a = a.Nextmatch()
' secondAddress = Cells(a, 2).Address '判斷ADDRESS後選取複製欄位
' Else
' End If
' i = i + 1
'
' Loop While secondAddress <> firstAddress
' Sheets("登錄").Select
'
'End If
Range("K9") = "=G7"
Range("K10") = "=H7"
Range("K11") = "=I7"
Range("K12") = "=J7"
Range("K13") = "=K7"
Range("K14") = "=L7"
Range("K15") = "=M7"
Range("K16") = "=N7"
Range("K17") = "=O7"
Range("K18") = "=P7"
Application.ScreenUpdating = True
End Sub