[發問] 2個活頁簿之工作表資料比對以及複製

帖子: 20
主題: 3
精華: 0
積分: 47
點名: 0
作業系統: WIN 7
軟體版本: OFFICE 2010
閱讀權限: 10
註冊時間: 2011-7-16
最後登錄: 2012-3-15

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2011-7-23 09:47 | 只看該作者

[發問] 2個活頁簿之工作表資料比對以及複製

「新」、「舊」活頁簿資料的判斷問題如下：
1.判斷「新」、「舊」活頁簿，A工作表之B欄位、B工作表之B欄位、C工作表之B欄位，儲存格內容文字是否相同
註1：比對方式為A表與A表比對；不是A表與B或C表比對
註2：B欄位相同筆數的資料，不會固定在某一列，例：「新」活頁簿A表之4454位在第5列，但「舊」活頁簿A表之4454位在3列

2.如果B欄位之文字內容相同，再判斷該筆於"舊"活頁簿C欄位有無資料，如果有資料，那麼進行複製到"新"活頁簿的C欄位；反之若沒有資料，則不需要做任何動作
例：「新」、「舊」活頁簿A表都有4454這筆資料，且「舊」活頁簿之4454這筆資料在C欄位有資料，所以要將該資料複製到「新」活頁簿之4454這筆資料的C欄位

請教大大們要怎麼寫…謝謝^^
註：檔案裡面有附上程式執行後呈現的結果

2個活頁簿之工作表資料比對及複製.zip (25.25 KB)

樓主熱帖

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

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

2^#

發表於 2011-7-23 11:45 | 只看該作者

回復 1# day741025

試試看

Sub Ex()
Dim D As Object, Wb(1 To 2) As Workbook, Sh As Worksheet, Rng As Range
Set Wb(1) = Workbooks("舊.xlsx")
Set Wb(2) = Workbooks("新.xlsx")
For Each Sh In Wb(1).Sheets '在Wb(1)的工作表集合物件依序裡每一工作表
Set D = CreateObject("SCRIPTING.DICTIONARY") '設立變數為字典物件
Set Rng = Sh.[B2] '舊.xlsx每一工作表的B2開始
Do
D(Rng.Value) = Rng.Offset(, 1) '紀錄C欄資料到字典物件
Set Rng = Rng.Offset(1) 'B欄往下移一列
Loop Until Rng = "" 'Rng = ""-> 離開迴圈
Set Rng = Wb(2).Sheets(Sh.Name).[B2] '新.xlsx每一工作表的B2開始
Do
If D.EXISTS(Rng.Value) Then Rng.Offset(, 1) = D(Rng.Value)
'EXISTS ->在Dictionary物件中指定的關鍵字( Rng.Value ) 存在，傳回 True，若不存在，傳回 False。
'D(Rng.Value) 取出資料
Set Rng = Rng.Offset(1) 'B欄往下移一列
Loop Until Rng = ""
Next
End Sub

複製代碼

帖子: 20
主題: 3
精華: 0
積分: 47
點名: 0
作業系統: WIN 7
軟體版本: OFFICE 2010
閱讀權限: 10
註冊時間: 2011-7-16
最後登錄: 2012-3-15

3^#

發表於 2011-7-23 12:13 | 只看該作者

本帖最後由 day741025 於 2011-7-23 12:21 編輯

回復 2# GBKEE

執行結果OK，感謝板主幫忙！

另外想要再問的就是，下述這段，如果是要從第3張工作表開始依序執行的話要怎麼設定？
For Each Sh In Wb(1).Sheets '在Wb(1)的工作表集合物件依序裡每一工作表
Set Rng = Wb(2).Sheets(Sh.Name).[B2] '新.xlsx每一工作表的B2開始
目前想到的是： For Each Sh In Wb(1).Worksheets(Array(3))

還有，如果C欄儲存格裡面有「插入註解」的話，可否把註解也放到目的儲存格裡？

謝謝^^

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

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

4^#

發表於 2011-7-23 13:03 | 只看該作者

回復 3# day741025
從第3個開始工作表依序到最後的工作表

Sub Ex()
Dim D As Object, Wb(1 To 2) As Workbook, Sh As Worksheet, Rng As Range
Dim i As Integer
Set Wb(1) = Workbooks("舊.xlsx")
Set Wb(2) = Workbooks("新.xlsx")
For i = 3 To Wb(1).Sheets.Count '舊.xlsx從第3個開始工作表依序到最後的工作表
Set D = CreateObject("SCRIPTING.DICTIONARY") '設立變數為字典物件
Set Rng = Wb(1).Sheets(i).[B2] '舊.xlsx每一工作表的B2開始
Do
Set D(Rng.Value) = Rng.Offset(, 1) '紀錄C欄 (Rang物件)
Set Rng = Rng.Offset(1) 'B欄往下移一列
Loop Until Rng = "" 'Rng = ""-> 離開迴圈
Set Rng = Wb(2).Sheets(i).[B2] '新.xlsx從第3個開始工作表依序到最後的工作表
Do
If D.EXISTS(Rng.Value) Then D(Rng.Value).Copy Rng.Offset(, 1)
'EXISTS ->在Dictionary物件中指定的關鍵字( Rng.Value ) 存在，傳回 True，若不存在，傳回 False。
'D(Rng.Value).Copy Rng.Offset(, 1) '複製儲存格
Set Rng = Rng.Offset(1) 'B欄往下移一列
Loop Until Rng = ""
Next
End Sub

複製代碼

帖子: 20
主題: 3
精華: 0
積分: 47
點名: 0
作業系統: WIN 7
軟體版本: OFFICE 2010
閱讀權限: 10
註冊時間: 2011-7-16
最後登錄: 2012-3-15

5^#

發表於 2011-7-24 15:04 | 只看該作者

回復 4# GBKEE

確認程式執行OK…
原本這個程式碼我要用IF跟For Next…但想了好久寫不太出來…板主真的好厲害@@"
感謝板主的鼎力相助！

帖子: 20
主題: 3
精華: 0
積分: 47
點名: 0
作業系統: WIN 7
軟體版本: OFFICE 2010
閱讀權限: 10
註冊時間: 2011-7-16
最後登錄: 2012-3-15

6^#

發表於 2011-7-24 21:04 | 只看該作者

本帖最後由 day741025 於 2011-7-24 21:20 編輯

回復 4# GBKEE

板主不好意思，我要問一下這段如果不寫「Rng=""」，不是也可以離開迴圈嗎？那麼為什麼還要加上「Rng=""」？
Loop Until Rng = "" 'Rng = ""-> 離開

剛才試過，如果拿掉「Rng=""」就會出現錯誤，再仔細看語句為Do 處理 Loop Until 條件式…
依照語句理解的意思是，條件式為當Rng為空白的時候，就離開迴圈！
更白話一點就是，當工作表之B2欄位移動到為空白的儲存格，就會離開迴圈，這樣是否正確？

謝謝！

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

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

7^#

發表於 2011-7-24 21:36 | 只看該作者

本帖最後由 GBKEE 於 2011-7-24 21:38 編輯

回復 6# day741025
如果拿掉「Rng=""」就會出現錯誤  請問錯誤出現在何處知道嗎?
Do
if a>15 then exit do    迴圈中間,有設下條件離開迴圈.
LooP
如迴圈中間沒設下條件離開迴圈,  也沒設下  While , Until, 條件迴圈是一直執行下去,沒完沒了

Do
Loop Until  [一直到條件為]  離開迴圈

Do  While [條件一直是] 繼續迴圈
Loop

帖子: 20
主題: 3
精華: 0
積分: 47
點名: 0
作業系統: WIN 7
軟體版本: OFFICE 2010
閱讀權限: 10
註冊時間: 2011-7-16
最後登錄: 2012-3-15

8^#

發表於 2011-7-24 22:11 | 只看該作者

本帖最後由 day741025 於 2011-7-24 22:14 編輯

回復 7# GBKEE

如果拿掉「Rng=""」就會出現錯誤請問錯誤出現在何處知道嗎?
我的判斷是，因為沒有設定條件的關係！

就好比if 條件式 then
如果沒有輸入條件式，就會出現錯誤！

下面的解說很清楚，大致上懂了，感謝板主的熱心教導！^^

帖子: 20
主題: 3
精華: 0
積分: 47
點名: 0
作業系統: WIN 7
軟體版本: OFFICE 2010
閱讀權限: 10
註冊時間: 2011-7-16
最後登錄: 2012-3-15

9^#

發表於 2011-7-24 22:48 | 只看該作者

本帖最後由 day741025 於 2011-7-24 22:51 編輯

回復 4# GBKEE

還有一個問題，最後Next為什麼沒有指定？

一般For Next，會先定義For i = 1 to 123
最後會指定Next i

是因為程式到了Loop Until就停止迴圈了，
所以最後的Next有沒有設定都沒有影響的關係嗎？

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

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

10^#

發表於 2011-7-25 08:59 | 只看該作者

回復 9# day741025
Next 有指定沒指定皆可