返回列表 上一主題 發帖

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

回復 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
複製代碼

TOP

回復 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
複製代碼

TOP

本帖最後由 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

TOP

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

TOP

        靜思自在 : 有心就有福,有願就有力,自造福田,自得福緣。
返回列表 上一主題