VBA 資料搜尋問題

Qin

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

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

      VBA語法.rar (24.39 KB)

下載次數: 25

2018-7-1 18:22

Qin

回復 1# Qin

   補充

VBA語法.rar (26.43 KB)

下載次數: 10

2018-7-1 21:34

ikboy

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

複製代碼

Farnsworth

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

Qin

回復 3# ikboy


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

ikboy

加一句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

複製代碼

Qin

回復 6# ikboy

為何不能運行? 請問, 是問題什麼?

下載 (92.46 KB)

2018-7-7 22:27

   

Book1.rar (22.33 KB)

下載次數: 6

2018-7-7 22:29

faye59

回復 1# Qin


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

faye59

回復 8# faye59


    搜尋資料1.xlsm

1. Cells(NextRow, 1) = n

複製代碼

這段沒改到，這麻煩自行修正。
Thanks!

Kubi

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

下載次數: 25

2018-7-14 19:56