- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 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
複製代碼 |
|