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

帖子: 178
主題: 65
精華: 0
積分: 252
點名: 0
作業系統: WINDOW7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2010-5-4
最後登錄: 2024-2-1

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2010-5-19 10:20 | 只看該作者

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

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

johntest.zip (8.5 KB)

樓主熱帖

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 257
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-27

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2010-5-19 18:17 | 只看該作者

回復 1# john2006168

Sub Ex()
Dim Ar()
Set d = CreateObject("Scripting.Dictionary")
Set dc1 = CreateObject("Scripting.Dictionary")
With Sheet1
For Each a In .Range(.[A2], .[A65536].End(xlUp))
d(a.Value) = a.Offset(, 1)
Next
For Each a In .Range(.[D2], .[D65536].End(xlUp))
dc1(a.Value) = a.Offset(, 1)
Next
End With
Sheet2.Columns("A:E") = ""
For Each ky In d.keys
If d(ky) <> dc1(ky) And d(ky) <> "" Then
ReDim Preserve Ar(s)
Ar(s) = Array(ky, d(ky))
s = s + 1
End If
Next
If s > 0 Then Sheet2.[A1].Resize(s, 2) = Application.Transpose(Application.Transpose(Ar))
s = 0: Erase Ar
For Each ky In dc1.keys
If d(ky) <> dc1(ky) And dc1(ky) <> "" Then
ReDim Preserve Ar(s)
Ar(s) = Array(ky, dc1(ky))
s = s + 1
End If
Next
If s > 0 Then Sheet2.[D1].Resize(s, 2) = Application.Transpose(Application.Transpose(Ar))
End Sub

複製代碼

學海無涯_不恥下問

john2006168

　暱稱: jjjohn

帖子: 178
主題: 65
精華: 0
積分: 252
點名: 0
作業系統: WINDOW7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2010-5-4
最後登錄: 2024-2-1

3^#

發表於 2010-5-19 22:52 | 只看該作者

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

sping

帖子: 25
主題: 4
精華: 0
積分: 156
點名: 0
作業系統: vista
軟體版本: office2007
閱讀權限: 20
性別: 男
註冊時間: 2010-5-13
最後登錄: 2021-8-29

論壇贊助勳章論壇榮譽勳章

4^#

發表於 2010-6-23 11:47 | 只看該作者

同工作表之資料比對.zip (764.28 KB) 回復 2# Hsieh

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

ps

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

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 257
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-27

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

5^#

發表於 2010-6-23 12:16 | 只看該作者

回復 4# sping

Sub 同工作表不同欄位之比對()
Dim Ar(), Ay()
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
With Sheets("同工作表之比對")
For Each a In .Range(.[A3], .[A65536].End(xlUp))
d(a.Text) = a.Text
d2(a.Text) = a.Text
Next
For Each a In .Range(.[B3], .[B65536].End(xlUp))
d1(a.Text) = a.Text
d2(a.Text) = a.Text
Next
ReDim Preserve Ar(s): Ar(s) = "相同Name": s = s + 1
ReDim Preserve Ay(k): Ay(k) = "不同Name": k = k + 1
For Each ky In d2.keys
If d.exists(ky) = True And d1.exists(ky) = True Then
ReDim Preserve Ar(s) '相同
Ar(s) = ky
s = s + 1
Else
ReDim Preserve Ay(k) '不同
Ay(k) = ky
k = k + 1
End If
Next
Range("c3:d65536") = ""
.[c2].Resize(s, 1) = Application.Transpose(Ar)
.[d2].Resize(k, 1) = Application.Transpose(Ay)
End With
End Sub

複製代碼

學海無涯_不恥下問

GBKEE

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

6^#

發表於 2010-6-23 16:09 | 只看該作者

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

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 257
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-27

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

7^#

發表於 2010-6-23 16:24 | 只看該作者

回復 6# GBKEE

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

學海無涯_不恥下問

sping

帖子: 25
主題: 4
精華: 0
積分: 156
點名: 0
作業系統: vista
軟體版本: office2007
閱讀權限: 20
性別: 男
註冊時間: 2010-5-13
最後登錄: 2021-8-29

論壇贊助勳章論壇榮譽勳章

8^#

發表於 2010-6-23 18:37 | 只看該作者

回復 5# Hsieh

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

正確之資料比對.zip (764.22 KB)

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