[發問] 對比不相同的資料

john2006168

各位老師求教啊....
請看附件...我想把sheet1AB 跟 DE 對比不相同的資料有在sheet 2 show出來,但是不成功..請問程式哪兒出錯 johntest.zip (8.5 KB)

下載次數: 19

2010-5-19 10:19

Hsieh

回復 1# john2006168

1. Sub Ex()
   
2. Dim Ar()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set dc1 = CreateObject("Scripting.Dictionary")
   
5. With Sheet1
   
6.    For Each a In .Range(.[A2], .[A65536].End(xlUp))
   
7.        d(a.Value) = a.Offset(, 1)
   
8.    Next
   
9.    For Each a In .Range(.[D2], .[D65536].End(xlUp))
   
10.        dc1(a.Value) = a.Offset(, 1)
    
11.    Next
    
12. End With
    
13. Sheet2.Columns("A:E") = ""
    
14.    For Each ky In d.keys
    
15.       If d(ky) <> dc1(ky) And d(ky) <> "" Then
    
16.          ReDim Preserve Ar(s)
    
17.          Ar(s) = Array(ky, d(ky))
    
18.          s = s + 1
    
19.       End If
    
20.     Next
    
21.     If s > 0 Then Sheet2.[A1].Resize(s, 2) = Application.Transpose(Application.Transpose(Ar))
    
22.     s = 0: Erase Ar
    
23.    For Each ky In dc1.keys
    
24.       If d(ky) <> dc1(ky) And dc1(ky) <> "" Then
    
25.          ReDim Preserve Ar(s)
    
26.          Ar(s) = Array(ky, dc1(ky))
    
27.          s = s + 1
    
28.       End If
    
29.     Next
    
30.     If s > 0 Then Sheet2.[D1].Resize(s, 2) = Application.Transpose(Application.Transpose(Ar))
    
31. End Sub

複製代碼

john2006168

先多謝老師,這麼多程序.要慢慢消化一下.

sping

同工作表之資料比對.zip (764.28 KB)

附件
下載次數: 15

2010-6-23 11:42

回復 2# Hsieh

Hsieh你好
因為我也有資料比對的需求，我有依你的程式碼作了一個小更改，因為我比對的資料欄位有數字格式，也可能有文字格式，所以就將a及b欄儲存格設為「文字格式」，可是設完後比對結果就會發生錯誤，可否請版主幫我看看，謝謝。

ps如果我將a及b來欄儲存格改為「通用格式」比對就會正常，可是當資料是「0800」時就會變成「800」這樣我的資料就會比對錯誤﹞

Hsieh

回復 4# sping

1. Sub 同工作表不同欄位之比對()
   
2. Dim Ar(), Ay()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. Set d2 = CreateObject("Scripting.Dictionary")
   
6. With Sheets("同工作表之比對")
   
7. For Each a In .Range(.[A3], .[A65536].End(xlUp))
   
8.    d(a.Text) = a.Text
   
9.    d2(a.Text) = a.Text
   
10. Next
    
11. For Each a In .Range(.[B3], .[B65536].End(xlUp))
    
12.    d1(a.Text) = a.Text
    
13.    d2(a.Text) = a.Text
    
14. Next
    
15. ReDim Preserve Ar(s): Ar(s) = "相同Name": s = s + 1
    
16. ReDim Preserve Ay(k): Ay(k) = "不同Name": k = k + 1
    
17. For Each ky In d2.keys
    
18.   If d.exists(ky) = True And d1.exists(ky) = True Then
    
19.   ReDim Preserve Ar(s) '相同
    
20.   Ar(s) = ky
    
21.   s = s + 1
    
22.   Else
    
23.   ReDim Preserve Ay(k) '不同
    
24.   Ay(k) = ky
    
25.   k = k + 1
    
26.   End If
    
27. Next
    
28. Range("c3:d65536") = ""
    
29. .[c2].Resize(s, 1) = Application.Transpose(Ar)
    
30. .[d2].Resize(k, 1) = Application.Transpose(Ay)
    
31. End With
    
32. End Sub

複製代碼

GBKEE

請各位看看4樓的附檔  工作表中僅A-D欄  會有一奇怪的現象
在列的最底端位置 按下[Ctrl+往上鍵]  第1次就會到最頂端有資料的儲存格的列位. 完全不理會中間的儲存格是否有資料
在第1列的位置 [Ctrl+往下鍵]   第1次會到有資料的儲存格的位置. 第2 次便直接會到列的最底端位置. 也完全不理會中間的儲存格是否有資料

Hsieh

回復 6# GBKEE


    有文字符號'存在
用資料剖析讓'消失即可恢復正常

sping

回復 5# Hsieh

Hsieh 您好
謝謝你抽空幫我看程式。
可是後來用你改好的程式碼去執行，有時候仍會發生錯誤，不曉得是我操作錯誤還是程式碼有問題
我附上兩個檔案，都是一樣的程式碼，可是執行結果會有差異，麻煩Hsieh版主或各位前輩幫我看看，謝謝
正確之資料比對.zip (764.22 KB)

下載次數: 7

2010-6-23 18:35

有問題之資料比對.zip (764.19 KB)

下載次數: 9

2010-6-23 18:35

Hsieh

原因是你的a:d欄空格含有看不見字元
用資料剖析把文字辨識符號取消即可

下載 (17.78 KB)

2010-6-23 18:52

下載 (21.26 KB)

2010-6-23 18:53

GBKEE

回復 7# Hsieh 謝謝 Hsieh 板主 解答
請問 你是如何找出的 我用AscB函數找不出來