軒云熊

回復 60# 准提部林
請問 準提大大 能不能寫成程式 這樣會較好理解 位置的運作方式  如果可以的話 ^^"  因為 放到字典裡 的資料位置  
不太明白是如何指定單一資料取出來

准提部林

回復 61# 軒云熊


論壇有很多例子可參考~~
或到這多學習, 有現成較新的帖子當參考:
http://club.excelhome.net/forum-2-1.html

軒云熊

回復 62# 准提部林
謝謝準大的指導  但這方式  只是在字典裡刪除重複而已  不過應該會比較快一點點  字典判斷重複陣列不提取的方式還在努力...

1. Public Sub 陣列加Function加字典練習()
   
2. Application.ScreenUpdating = False
   
3. If [成果!A1] <> "" Then [成果!A1].CurrentRegion.Clear
   
4. Crr = [目標!A1].CurrentRegion
   
5. Brr = [庫存!A1].CurrentRegion
   
6. ReDim Drr(1 To UBound(Brr, 1), 1 To UBound(Brr, 2))
   
7. Set xD = CreateObject("Scripting.Dictionary")
   
8.     For i = 1 To UBound(Crr)
   
9.         A3 = 分割文字(Trim(Crr(i, 3)))
   
10.         A1 = Trim(Crr(i, 1))
    
11.         For N = 1 To UBound(Brr)
    
12.             B3 = 分割文字(Trim(Brr(N, 3)))
    
13.             B1 = Trim(Brr(N, 1))
    
14.             If A1 Like B1 Or A3 Like B3 And A3 <> "" Then
    
15.                xD(Brr(N, 1)) = Brr(N, 1)
    
16.             End If
    
17.         Next N
    
18.     Next i
    
19.     For E = 1 To UBound(Brr)
    
20.         If Brr(E, 1) = xD(Brr(E, 1)) Then
    
21.             G = G + 1
    
22.             For F = 1 To UBound(Brr, 2)
    
23.                 Drr(G, F) = Brr(E, F)
    
24.             Next F
    
25.         End If
    
26.     Next E
    
27. Erase Brr, Crr
    
28. [成果!A1].Resize(G, UBound(Drr, 2)) = ""
    
29. [成果!A1].Resize(G, UBound(Drr, 2)) = Drr
    
30. Erase Drr
    
31. Sheets(3).Activate
    
32. Cells(1, 1).Select
    
33. Application.ScreenUpdating = False
    
34. End Sub
    
35. '====================================================================
    
36. Public Function 分割文字(A3)
    
37.     Drx = Array("-", ".")
    
38.     A7 = "": A8 = ""
    
39.     For A9 = LBound(Drx) To UBound(Drx)
    
40.         For A0 = 1 To Len(A3)
    
41.             If InStr(Mid(Right(A3, A0), 1, 1), Drx(A9)) Then
    
42.                 A8 = Mid(Right(A3, A0), 1, A0)
    
43.                 A7 = Mid(A3, 1, Len(A3) - Len(A8))
    
44.             Exit For
    
45.             End If
    
46.         Next A0
    
47.     Next A9
    
48.     If A7 = "" Then A7 = A3
    
49.     If A7 = "" Then Exit Function
    
50.     If Left(A7, 4) Like "####" Then
    
51.        X = Mid(A7, 1, 4)
    
52.     ElseIf Left(A7, 5) Like "####[A-Z]" Then
    
53.        X = Mid(A7, 1, 5)
    
54.     ElseIf Left(A7, 5) Like "[A-Z]####" Then
    
55.        X = Mid(A7, 1, 5)
    
56.     ElseIf Left(A7, 8) Like "???-????" Then
    
57.        X = Mid(A7, 1, 8)
    
58.     End If
    
59.     If X = "" Then X = A3
    
60.     分割文字 = X
    
61. End Function

複製代碼

qaqa3296

回復 63# 軒云熊

測試一下
查詢33個資料，資料庫數7000

陣列練習加Function練習_1=>11秒
陣列加Function加字典練習=>4秒

資料列出相同

Andy2483

回復 1# qaqa3296


    謝謝前輩發表此主題與範例
不論是否符合需求! 後學在此帖學到很多知識!
後學的陣列與字典練習心得註解如下:
Option Explicit
Sub TEST_1()
Dim Brr, Arr, c&, R&, V, Y, Z
Dim K$, P$, Q, S
'↑宣告變數
S = Timer
Sheets(3).[M2:P60000].ClearContents
Set Y = CreateObject("Scripting.Dictionary")
Set Z = CreateObject("Scripting.Dictionary")
Set V = CreateObject("Scripting.Dictionary")
'↑令Y,Z,V各是字典
Arr = Sheets(1).Range("A1:C" & Sheets(1).[A65536].End(3).Row)
'↑目標表 陣列範圍
For R = 1 To UBound(Arr)
'↑外順迴圈把 目標表 規格拆解,重組為模糊比對關鍵字並倒入V字典
   For c = 1 To UBound(Arr, 2)
   '↑內順迴圈去除空白字元
      Arr(R, c) = Replace(Arr(R, c), " ", "")
   Next
   P = Arr(R, 3)
   If P Like "*-*-*" Then
      P = Split(P, "-")(0) & "-" & Split(P, "-")(1)
      ElseIf P = "" Then
      '↑如果規格欄是空格 就以A欄格與B欄格組為模糊比對關鍵字
         P = Arr(R, 1) & Arr(R, 2)
   End If
   V(P) = 1
   '↑倒入V字典
   P = ""
Next
Brr = Sheets(2).Range("D1:A" & Sheets(2).[A65536].End(3).Row)
'↑庫存表 陣列範圍
For R = 1 To UBound(Brr)
'↑外順迴圈把 庫存表 規格拆解,重組再加入符號 "|" 與列數
',為模糊比對關鍵字並倒入Z字典
   For c = 1 To UBound(Brr, 2)
   '↑內順迴圈去除空白字元
      Brr(R, c) = Replace(Brr(R, c), " ", "")
      P = P & Brr(R, c) & "|"
     '↑把每列4欄的資料用 "|" 串起來
   Next
   K = Brr(R, 3)
   If K Like "*-*-*" Then
      K = Split(K, "-")(0) & "-" & Split(K, "-")(1)
      ElseIf K = "" Then
         K = Brr(R, 1) & Brr(R, 2)
   End If
   Z(K & "|" & R) = P  '@@
   '↑重組再加入符號 "|" 與列數
   P = ""
Next
For Each Q In Z.KEYS
   If V(Split(Q, "|")(0)) = 1 Then
   '↑用 "|" 拆解Z字典裡的key,字串在V字典找到,代表符合提取條件
      Y(Q) = Split(Z(Q), "|")
      '↑用Y字典裝 符合條件 的Z字典item資料  @@處
   End If
Next
Arr = Application.Transpose(Application.Transpose(Y.items))
'↑將Y字典的 items 轉置兩次 就是結果資料
Sheets(3).[M1].Resize(Y.Count, 4) = Arr
MsgBox Timer - S & "秒"
End Sub