要求利用Excel VBA输出后四列

使用vba实现

1、原始数据情况：

2、vbe输入代码

3、代码：

Sub 按钮3_Click()
    Application.ScreenUpdating = False '关闭刷屏
    arr = [a1].CurrentRegion '将输入赋值给数组，提高效率
    Set d1 = CreateObject("scripting.dictionary") '总金额汇总
    Set d2 = CreateObject("scripting.dictionary") '笔数汇总
    Set d3 = CreateObject("scripting.dictionary") '数量汇总
    For j = 2 To UBound(arr) '用字典去重统计汇总
        d1(arr(j, 1)) = d1(arr(j, 1)) + arr(j, 5)
        d2(arr(j, 1)) = d2(arr(j, 1)) + 1
        d3(arr(j, 1)) = d3(arr(j, 1)) + arr(j, 3)
    Next j
    [j2].Resize(d1.Count) = WorksheetFunction.Transpose(d1.keys) '返回不重复的购货单位名称
    [k2].Resize(d1.Count) = WorksheetFunction.Transpose(d1.items) '返回购货单位对应的汇总金额
    arr = [j1].CurrentRegion '将新生成的j-m全区域赋值给数组，提速
    For j = 0 To d2.Count - 1
        arr(j + 2, 3) = d1.items()(j) / d2.items()(j) '计算平均每笔价格
        arr(j + 2, 4) = d1.items()(j) / d3.items()(j) '计算平均价格
    Next j
    [j1].CurrentRegion = arr
    Application.ScreenUpdating = True
End Sub

4、执行后实现效果