返回列表 上一主題 發帖

[發問] 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

        靜思自在 : 不要隨心所欲,要隨心教育自己。
返回列表 上一主題