返回列表 上一主題 發帖

VBA 資料搜尋問題

VBA 資料搜尋問題

我有一個龐大的資料庫(資料已超出65536筆),因為 Excel 的公式已經不能滿足我的需求, 所以想以 VBA 解決問題

     請問當我想以"編號"或者以"品名"再或者想以"廠商"搜尋資料, 這時 VBA 的語法要如何撰寫?
     (當然這3個問題不是同一時間一起進行)

      VBA語法.rar (24.39 KB)

回復 1# Qin

   補充

VBA語法.rar (26.43 KB)

TOP

Dim d As Object, k, t, s$
  1. Private Sub Worksheet_Activate()
  2. If d Is Nothing Then dic
  3. End Sub
複製代碼
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. Application.EnableEvents = 0
  3. Set td = Application.Intersect([b1:b3], Target)
  4. If Not td Is Nothing Then
  5.     If Len(td.Value) Then
  6.         k = td.Value: [b1:b3] = "": td.Value = k
  7.         a = Array("CD#", "DC#", "CO#")
  8.         k = a(td.Row - 1) & td.Value
  9.         ar = Sheets("資料庫").[a1].CurrentRegion.Value
  10.         If d Is Nothing Then dic
  11.         t = Split(d(k), "|")
  12.         ReDim b(1 To UBound(t), 1 To UBound(ar, 2))
  13.         For i = 1 To UBound(t)
  14.             b(i, 1) = i
  15.             For j = 2 To UBound(ar, 2)
  16.                 b(i, j) = ar(t(i), j)
  17.             Next
  18.         Next
  19.         [a5].CurrentRegion.Offset(4).Clear
  20.         [a5].Resize(i - 1, j - 1) = b
  21.     End If
  22. End If
  23. Application.EnableEvents = 1
  24. End Sub
複製代碼
  1. Sub dic()
  2. Set d = CreateObject("scripting.dictionary")
  3. ar = Sheets("資料庫").[a1].CurrentRegion.Value
  4. For i = 2 To UBound(ar)
  5.     d("CO#" & ar(i, 4)) = d("CO#" & ar(i, 4)) & "|" & i
  6.     d("CD#" & ar(i, 6)) = d("CD#" & ar(i, 6)) & "|" & i
  7.     d("DC#" & ar(i, 7)) = d("DC#" & ar(i, 7)) & "|" & i
  8. Next
  9. For Each t In Array("CD#", "DC#", "CO#")
  10.     k = Filter(d.keys, t): s = ""
  11.     For i = 0 To UBound(k)
  12.         k(i) = Replace(k(i), t, "")
  13.     Next
  14.     For i = 0 To UBound(k) - 1
  15.         For j = i + 1 To UBound(k)
  16.             If k(j) < k(i) Then t = k(i): k(i) = k(j): k(j) = t
  17.         Next
  18.     Next
  19.     n = n + 1
  20.     With Range("b" & n).Validation
  21.         .Delete
  22.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
  23.         xlBetween, Formula1:=Join(k, ",")
  24.     End With
  25. Next
  26. End Sub
複製代碼

zz.zip (35.06 KB)

TOP

一直在学习中,下载看看,感谢分享你的技术与经验,谢谢!!!

TOP

回復 3# ikboy


首先, 謝謝 ikboy 的幫助,接下來, 還有2個問題,可否請你抽空幫我看看…. 在此謝過.

zz.rar (22.6 KB)

TOP

加一句AntoFilter不是更好作關聯嗎。
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. Application.EnableEvents = 0
  3. Dim td As Range, a, ar, i&, j&
  4. Set td = Application.Intersect([b1:b3], Target)
  5. If Not td Is Nothing Then
  6.     If Len(td.Value) Then
  7.         k = td.Value: [b1:b3] = "": td.Value = k
  8.         a = Array("CD#", "DC#", "CO#")
  9.         k = a(td.Row - 1) & td.Value
  10.         ar = Sheets("Data").[a1].CurrentRegion.Value
  11.         If d Is Nothing Then dic
  12.         t = Split(d(k), "|")
  13.         ReDim b(1 To UBound(t), 1 To UBound(ar, 2))
  14.         For i = 1 To UBound(t)
  15.             b(i, 1) = i
  16.             For j = 2 To UBound(ar, 2)
  17.                 b(i, j) = ar(t(i), j)
  18.             Next
  19.         Next
  20.         [a5].CurrentRegion.Offset(4).Clear
  21.         [a5].Resize(i - 1, j - 1) = b
  22.         [color=Red][a4:j4].AutoFilter[/color]
  23.     End If
  24. End If
  25. Application.EnableEvents = 1
  26. End Sub
複製代碼

TOP

回復 6# ikboy

為何不能運行? 請問, 是問題什麼?
Search Data.png
2018-7-7 22:27

   

Book1.rar (22.33 KB)

TOP

回復 1# Qin


   
提供兩個版本給你,看看適不適用。

搜尋資料.rar (420.85 KB)

一分努力,一分收穫。
發問題前可以先搜索內文是否有相關範例。

TOP

回復 8# faye59


    搜尋資料1.xlsm
  1. Cells(NextRow, 1) = n
複製代碼
這段沒改到,這麻煩自行修正。
Thanks!
一分努力,一分收穫。
發問題前可以先搜索內文是否有相關範例。

TOP

回復 1# Qin
請參考
VBA資料搜尋.rar (43.67 KB)

TOP

        靜思自在 : 願要大、志要堅、氣要柔、心要細。
返回列表 上一主題