Hsieh

回復 1# milkpillow

1. Sub Q_Table()
   
2. Dim A As Range, C As Range, Ar()
   
3. With Sheets("B全部紀錄")
   
4. For Each A In .Range(.[A2], .[A1048576].End(xlUp))
   
5.    Set C = Sheets("A收集").Columns("C").Find(A, lookat:=xlWhole)
   
6.      If Not C Is Nothing Then
   
7.        ReDim Preserve Ar(s)
   
8.        Ar(s) = Array(C.Offset(, -2).Value, C.Offset(, -1).Value, A.Offset(, 1).Value, A.Offset(, 2).Value, A.Offset(, 3).Value)
   
9.        s = s + 1
   
10.    End If
    
11. Next
    
12. End With
    
13. Sheets("C輸出").[A2:E1048576].Clear
    
14. If s > 0 Then Sheets("C輸出").[A2].Resize(s, 5) = Application.Transpose(Application.Transpose(Ar))
    
15. Sheets("C輸出").Select
    
16. End Sub

複製代碼

pro.rar (19.82 KB)

下載次數: 40

2010-5-29 09:01

Hsieh

回復 5# milkpillow


    這樣2個表的關聯性不足
並不知道每筆確定的比對對象
請說明2表資料的比對規則
重新思考邏輯

Hsieh

回復 7# milkpillow


    A收集的品名跟B全部資料的OS_NAME有甚麼關連對應索引?
或是確定數量會相同?

Hsieh

回復 9# milkpillow

試試看是不是這樣的意思

1. Sub matchdata()
   
2. Dim Ay()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. With Sheet2
   
5.   For Each A In .Range(.[A2], .[A65536].End(xlUp))
   
6.      If d.exists(A.Value) = False Then
   
7.         d(A.Value) = Join(Array(A, A.Offset(, 1), A.Offset(, 2), A.Offset(, 3)), ",")
   
8.         Else
   
9.         d(A.Value) = d(A.Value) & ";" & Join(Array(A, A.Offset(, 1), A.Offset(, 2), A.Offset(, 3)), ",")
   
10.      End If
    
11.     Next
    
12. End With
    
13. With Sheet1
    
14.    For Each A In .Range(.[C2], .[C65536].End(xlUp))
    
15.       If d.exists(A.Value) = True Then
    
16.          Ar = Split(d(A.Value), ";")
    
17.          For i = 0 To UBound(Ar)
    
18.          ReDim Preserve Ay(s)
    
19.          Ay(s) = Split(A.Offset(, -2) & "," & A.Offset(, -1) & "," & Ar(i), ",")
    
20.          s = s + 1
    
21.          Next
    
22.          Else
    
23.          If mystr = "" Then mystr = A Else mystr = mystr & "," & 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))
    
30. MsgBox mystr & "沒找到"
    
31. End With
    
32. End Sub

複製代碼

Hsieh

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