milkpillow

1. Sub matchdata()
   
2. Dim Ay() '全域變數Ay用來放最終結果
   
3. Set d = CreateObject("Scripting.Dictionary") '創立一個 二維陣列的物件d
   
4. With Sheet2
   
5.   For Each A In .Range(.[A2], .[A65536].End(xlUp)) '第二張表的A欄 逐列 =暫存變數A
   
6.      If d.exists(A.Value) = False Then '用Dictionary的Exists函數 來檢查比對A的值如果沒有則執行下一行
   
7.         d(A.Value) = Join(Array(A, A.Offset(, 1), A.Offset(, 2), A.Offset(, 3)), ",") '取值?? 橫向的 1A,1B,1C 醬
   
8.         Else '如果有
   
9.         d(A.Value) = d(A.Value) & ";" & Join(Array(A, A.Offset(, 1), A.Offset(, 2), A.Offset(, 3)), ",") '串聯起來用;隔開 變成1A,1B,1C;2A,2B,2C 取出的時候會變成兩列或更多列的三欄資料
   
10.      End If
    
11.     Next
    
12. End With
    
13. With Sheet1
    
14.    For Each A In .Range(.[C2], .[C65536].End(xlUp)) '第一張表的C欄 逐列 =暫存變數A
    
15.       If d.exists(A.Value) = True Then '二維陣列d的物件 若有包含這次的變數a
    
16.          Ar = Split(d(A.Value), ";") '取出可用的數筆資料 直向的 可用筆數 X ABC三欄  
    
17.          For i = 0 To UBound(Ar) '0到 陣列Ar的最大值
    
18.          ReDim Preserve Ay(s) '保存動態陣列的內容 (為什麼儲存寫在前面 處理方式寫在下一行?)
    
19.          Ay(s) = Split(A.Offset(, -2) & "," & A.Offset(, -1) & "," & Ar(i), ",")
    
20.          s = s + 1 '目前列+1
    
21.          Next
    
22.          Else
    
23.          If mystr = "" Then mystr = A Else mystr = mystr & "," & A '若d.exists(A.Value) = false 寫入一個警告顯示目前變數A
    
24.         End If
    
25.     Next
    
26. End With
    
27. With Sheet3
    
28. .[A2:F65536] = "" '清空第三張表
    
29. .[A2].Resize(s, 6) = Application.Transpose(Application.Transpose(Ay)) '第三張表 的A2欄 開始寫入轉換過的行列 轉換了兩次 超深奧 無法想像..
    
30. MsgBox mystr & "沒找到" '彈出警告視窗
    
31. End With
    
32. End Sub

複製代碼

Hsieh 大大 目前應用正確了
這是我目前自己寫的注解 不知道是不是正確..
另外想請問一下
為什麼要先讀入全部的Sheet2的欄位，若Sheet2有好幾萬筆的時候 有沒有效能問題呀?
處理過程中 有把變數拆開 Split 又組合 Join 我不是很了解那些
有沒有什麼辦法 可以看到d(A.Value) 的值是怎麼變化的呢?

(我真的是超超超新手，旁邊的不要笑 )

Hsieh

效能如何就看你記憶體夠不夠
如果變數都完成宣告就會好一點