返回列表下一主題上一主題發帖

[發問] 多簿多表匹配同名工作表中的相同列標題後複製

shuo1125

中學生 Rank: 2

帖子: 121
主題: 8
精華: 0
積分: 170
點名: 62
作業系統: win10
軟體版本: Office2016
閱讀權限: 20
性別: 男
註冊時間: 2021-1-21
最後登錄: 2024-8-20

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2024-1-3 13:21 | 只看該作者

[發問] 多簿多表匹配同名工作表中的相同列標題後複製

各位前輩好!
請問想針對路徑中多工作簿匹配同名工作表以及相同列標題名稱後複製到當前活頁簿中要如何做??
----------------------------------------------------------------------------------------------------------
之前准大曾分享過兩表列標題匹配複製的案例，但變成多簿多表不知如何操作....
且同工作表下可能出現相同名稱之欄位.....
詳見範例檔，匹配同工作表名以及列標題後複製到Copy工作簿。
(Copy-當前活頁簿，Wb1.Wb2.為工作簿,裡面的S1,S2,S4為預計要複製的工作表,紅色為重複之列名稱。)
謝謝大家!!

TEST_20240103.zip (25.24 KB)

樓主熱帖

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

2^#

發表於 2024-1-3 15:19 | 只看該作者

本帖最後由 Andy2483 於 2024-1-3 16:25 編輯

回復 1# shuo1125

謝謝論壇,謝謝前輩發表此主題與範例
後學藉此帖練習字典與物件,學習方案如下,請前輩參考

Option Explicit
Sub TEST()
Dim Z, PH$, FN$, i&, C As Range, xB As Workbook, S As Worksheet
Set Z = CreateObject("Scripting.Dictionary")
For Each S In Worksheets
For Each C In S.[1:1].SpecialCells(2): Set Z(S.Name & "|" & C) = ThisWorkbook.Sheets(S.Name).Range(C.Address): Next
Next
PH = ThisWorkbook.Path
Application.ScreenUpdating = False
Do
If FN = "" Then FN = Dir(PH & "\*.xlsx") Else FN = Dir
If FN = "" Then Exit Do
'If FN = ThisWorkbook.Name Then GoTo DP
Set xB = Workbooks.Open(PH & "\" & FN, ReadOnly:=True)
For Each S In Worksheets
   For Each C In S.[1:1].SpecialCells(2)
      If Z.Exists(S.Name & "|" & C) = Empty Then GoTo C01
      C.EntireColumn.Copy Z(S.Name & "|" & C)
C01:  Next
Next
xB.Close 0
DP: Loop
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

Andy2483