返回列表 上一主題 發帖

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

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
1# 跳轉到 »
發表於 2015-6-30 19:30 | 顯示全部帖子
回復 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)

  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

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

TOP

        靜思自在 : 有願放在心裡，沒有身體力行，正如耕田不播種，皆是空過因緣。
返回列表 上一主題