VBA：遍历字典复制指定列的数据到目标列

前言：因为考虑数据量的问题，所以在计算季度数据的时候，做了一个辅助列“季度累计数（至上月）”，季度累计数=本月发展数+季度累计数（至上月），这样就碰到一个问题：需要每个月都把季度累计数复制到季度累计数（至上月）
如果列数少的话还好，列数一多真的要奔溃；如果每个月还有要改模板的话，就更讨厌了
所以用vba写了一段脚本，自动做上述工作，只需要确定好从什么名字的列复制到什么名字的列即可

Sub 季度数据复制()

'获得最大行数
Sheets("门店维度").Select
maxrow = Sheets("门店维度").UsedRange.Rows.Count - 1 '因为我最后一行是合计的公式，所以不复制

'构建字典，key是原始列（需要复制的），value是目标列（需要黏贴的）
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
dict.Add "宽带季度完成数", "宽带季度完成数（至上月）"
dict.Add "季度累计融合发展量", "季度累计融合发展量（至上月）"
dict.Add "季度累计非主流融合发展量", "季度累计非主流融合发展量（至上月）"
dict.Add "季度累计129及以上发展量", "季度累计129及以上发展量（至上月）"
dict.Add "价值宽带季度完成数", "价值宽带季度完成数（至上月）"
dict.Add "移动季度完成数", "移动季度完成数（至上月）"
dict.Add "新战狼季度完成数", "新战狼季度完成数（至上月）"
dict.Add "199+30季度累计", "199+30季度累计（至上月）"
dict.Add "精品智能组网季度累计", "精品智能组网季度累计（至上月）"
dict.Add "50G包季度累计", "50G包季度累计（至上月）"
dict.Add "宽带提速包季度累计", "宽带提速包季度累计（至上月）"
dict.Add "橙分期季度累计", "橙分期季度累计（至上月）"

For Each k In dict
    k_column = Rows(3).Find(k, LookAt:=xlWhole).Column '在第三行里找到和k一模一样的值的列号，如5
    v = dict.Item(k)
    v_column = Rows(3).Find(v, LookAt:=xlWhole).Column '获得value的列号，如6
    Range(Cells(4, k_column), Cells(maxrow, k_column)).Select
    Range(Cells(4, k_column), Cells(maxrow, k_column)).Copy
    Cells(4, v_column).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Next
 
End Sub