VBA:快速把另一個工作簿裏的列值根據列名填充進來

前言:之前在使用工作簿與工作簿之間的數據連接時,使用的是vlookup手動做鏈接,然後斷開連接並另存爲的方式,雖然做好一次後很方便,但是每次變動需求要修改的話都好累。比如我這裏有36個,也就是相當於要做36次vlookup!
所以乾脆寫了一段代碼,把一個工作簿裏的數據直接黏貼到另一個工作簿裏,根據列名自動查找匹配
注:這裏用的是字典,如果兩個工作簿的列名一致的話,可以用數組來代替,更方便。

Sub 日報數據複製(blank As String)

'獲得最大行數
maxrow = Workbooks("!源數據(每日刷新).xlsm").Sheets("日報數據").UsedRange.Rows.Count

'構建字典,key是原始列(需要複製的),value是目標列(需要黏貼的)
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
dict.Add "日寬帶發展量", "日寬帶"
dict.Add "月寬帶發展量", "月寬帶"
dict.Add "日移動發展", "日移動"
dict.Add "月移動發展", "月移動"
dict.Add "日5G新增套餐", "日5G新增套餐"
dict.Add "日5G存量套餐", "日5G存量套餐"
dict.Add "日5G包", "日5G包"
dict.Add "月5G新增套餐", "月5G新增套餐"
dict.Add "月5G存量套餐", "月5G存量套餐"
dict.Add "月5G包", "月5G包"
dict.Add "日銷售額", "日銷售額"
dict.Add "月銷售額", "月銷售額"
dict.Add "日129及以上", "日129及以上套餐"
dict.Add "月129及以上", "月129及以上套餐"
dict.Add "月新增公客", "月公客寬帶發展數"
dict.Add "日主動拆機", "日寬帶主動拆機"
dict.Add "日寬帶在線", "日寬帶在線"
dict.Add "月主動拆機", "月寬帶主動拆機"
dict.Add "月寬帶在線", "月寬帶在線"
dict.Add "日橙分期", "日橙分期"
dict.Add "月橙分期", "月橙分期"
dict.Add "日疊疊樂", "日疊疊樂"
dict.Add "月疊疊樂", "月疊疊樂"
dict.Add "月疊疊樂副卡", "月新增副卡"
dict.Add "日全屋wifi", "日全屋WIFI"
dict.Add "月全屋wifi", "月全屋WIFI"
dict.Add "日收費家庭雲", "日家庭雲"
dict.Add "月收費家庭雲", "月家庭雲"
dict.Add "新增寬帶家庭雲分母", "新增寬帶疊加率分母"
dict.Add "新增寬帶家庭雲分子", "新增寬帶疊加率分子"
dict.Add "日天翼看家", "日天翼看家"
dict.Add "月天翼看家", "月天翼看家"
dict.Add "日小翼管家", "日小翼管家"
dict.Add "月小翼管家", "月小翼管家"
dict.Add "日播播TV", "日播播TV"
dict.Add "月播播TV", "月播播TV"

For Each k In dict
    k_column = Workbooks("!源數據(每日刷新).xlsm").Sheets("日報數據").Rows(1).Find(k, LookAt:=xlWhole).Column '在第三行裏找到和k一模一樣的值的列號,如5
    k_col = CNtoW(k_column)
    v = dict.Item(k)
    v_column = Workbooks("日報模板(會用宏的可以用用).xlsm").Sheets("門店維度").Rows(3).Find(v, LookAt:=xlWhole).Column '獲得value的列號,如6
    v_col = CNtoW(v_column)
    Workbooks("!源數據(每日刷新).xlsm").Sheets("日報數據").Range(k_col & "2:" & k_col & maxrow).Copy
    Workbooks("日報模板(會用宏的可以用用).xlsm").Sheets("門店維度").Range(v_col & "4:" & v_col & (maxrow + 3)).PasteSpecial Paste:=xlPasteFormulas
Next
 
End Sub

'列數轉字母
Function CNtoW(ByVal num As Long) As String
    CNtoW = Replace(Cells(1, num).Address(False, False), "1", "")
End Function

'字母轉列數
Function CWtoN(ByVal AB As String) As Long
    CWtoN = Range("a1:" & AB & "1").Cells.Count
End Function
發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章