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
发布了90 篇原创文章 · 获赞 106 · 访问量 5万+

猜你喜欢

转载自blog.csdn.net/weixin_42029733/article/details/103302709
今日推荐