使用代码实现sumif的功能

yoyosin

如图，数据源是基础数据，我想实现，
1、当点击“生成表格”标签时，将 数据源 中 编号列 筛选出唯一值，记录到 生成表格 的 编号列。
2、将 数据源 中相同编号 第一行对应的 品类 记录到 生成表格的 名称列。
3、将 数据源 中相同编号的 数量求和，记录到 生成表格 的数量列。
4、将 数据源 中相同编号的 合计求和，记录到 生成表格 的合计列。
请各位友人帮忙解决，非常感谢！！ 数据源及生产表格.zip (7.52 KB, 下载次数: 10)

2014-8-27 19:12 上传

点击文件名下载附件

该贴已经同步到 yoyosin的微博

EH2003

代码试试看看：
Sub test()
     Dim d, arr, brr
     Set d = CreateObject("Scripting.Dictionary")
     arr = Sheets("数据源").Range("A1").CurrentRegion
     ReDim brr(1 To UBound(arr), 1 To 6)
     For i = 2 To UBound(arr)
         s = arr(i, 1) & arr(i, 2)
         If d(s) = "" Then
             m = m + 1
             d(s) = m
             brr(m, 1) = arr(i, 1)
             brr(m, 2) = arr(i, 2)
'             brr(m, 3) = arr(i, 3)
'             brr(m, 4) = arr(i, 4)
             brr(m, 5) = arr(i, 5)
             brr(m, 6) = arr(i, 6)
         Else
             brr(d(s), 5) = brr(d(s), 5) + arr(i, 5)
             brr(d(s), 6) = brr(d(s), 6) + arr(i, 6)
         End If
     Next
     
     Sheets("生成表格").Range("a1:f1") = Array("编号", "品类", "名称", "单价", "数量", "合计")
     Sheets("生成表格").Range("A2").Resize(m, 6) = brr
End Sub

EH2003

数据源及生产表格.zip (18.22 KB, 下载次数: 22)

2014-8-27 19:59 上传

点击文件名下载附件

yoyosin

EH2003 发表于 2014-8-27 19:59

谢谢你！可以实现我预期的功能！
现在还有一个问题请教你，我的表头是从第二行开始的，第一行是汇总列，帮忙修改一下代码！

EH2003

Sub test()
     Dim d, arr, brr
     Set d = CreateObject("Scripting.Dictionary")
     arr = Sheets("数据源").Range("A2").CurrentRegion
     ReDim brr(1 To UBound(arr), 1 To 6)
     For i = 3 To UBound(arr)
         s = arr(i, 1) & arr(i, 2)
         If d(s) = "" Then
             m = m + 1
             d(s) = m
             brr(m, 1) = arr(i, 1)
             brr(m, 2) = arr(i, 2)
'             brr(m, 3) = arr(i, 3)
'             brr(m, 4) = arr(i, 4)
             brr(m, 5) = arr(i, 5)
             brr(m, 6) = arr(i, 6)
         Else
             brr(d(s), 5) = brr(d(s), 5) + arr(i, 5)
             brr(d(s), 6) = brr(d(s), 6) + arr(i, 6)
         End If
     Next
     
     Sheets("生成表格").Range("a2:f2") = Array("编号", "品类", "名称", "单价", "数量", "合计")
     Sheets("生成表格").Range("A3").Resize(m, 6) = brr
End Sub

yoyosin

EH2003 发表于 2014-8-28 18:59
Sub test()
     Dim d, arr, brr
     Set d = CreateObject("Scripting.Dictionary")

哈哈 谢谢！！