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

day741025

「新」、「舊」活頁簿資料的判斷問題如下：
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)

資料
下載次數: 24

2011-7-23 09:44

GBKEE

回復 1# day741025


試試看

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

複製代碼

day741025

回復 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欄儲存格裡面有「插入註解」的話，可否把註解也放到目的儲存格裡？

謝謝^^

GBKEE

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

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

複製代碼

day741025

回復 4# GBKEE


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

day741025

回復 4# GBKEE


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


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

謝謝！

GBKEE

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

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


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

day741025

回復 7# GBKEE


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

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

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

day741025

回復 4# GBKEE



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

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

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

GBKEE

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