博客

前言：最近有一项新工作，需要填充如下的表格



上面只是一个代理商而已，而同样的代理商有十几家。传统的做法就是做好数据处理后，通过vlookup匹配填充。稍微方便一点的是调整好格式后直接复制黏贴，但是因为不是每个代理商每个月都有这么多佣金类型的，所以可能会出错。当然用power query固定化模板后也是可以操作的，但是我想试试VBA，所以写了以下的代码，通过数组和字典快速填充数字。

9月16日更新：之前的数组太复杂了，学到了简单的，更新一下，如果字典也能像python那样简单就好了

Sub 数据快速填充()

'首先构建1个代理商表

agent_array = Array("共志", "千秋", "汉启", "易贝", "外金", "共联", "宁皙", "君弘", "鹏德", "仲诚", "公惠", "电信实业", "茗神", "迪信", "欧珀", "步步高")

'构建字典，key是原始列（需要复制的），value是目标列（需要黏贴的）
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
dict.Add "201903", "C"
dict.Add "201904", "D"
dict.Add "201905", "E"
dict.Add "201906", "F"
dict.Add "201907", "G"

'然后通过循环，把相关数据匹配到表格内

For Each i In agent_array
'    MsgBox i
    For Each j In dict:
        v = dict.Item(j)
        '先调好相关参数
        Sheets("总数据").Select
        ActiveSheet.PivotTables("数据透视表4").PivotFields("代理商简称").ClearAllFilters
        ActiveSheet.PivotTables("数据透视表4").PivotFields("代理商简称").CurrentPage = i
        ActiveSheet.PivotTables("数据透视表4").PivotFields("结算账期").ClearAllFilters
        ActiveSheet.PivotTables("数据透视表4").PivotFields("结算账期").CurrentPage = j
        '然后把相关内容vlookup到相关单元格
        Sheets(i).Select
        Range(v & "2").Select
        ActiveCell.FormulaR1C1 = "=VLOOKUP(RC2,总数据!C8:C9,2,0)"
        Selection.AutoFill Destination:=Range(v & "2:" & v & "14"), Type:=xlFillDefault
        Range(v & "2:" & v & "14").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    Next
Next

End Sub