[已解决]恳请各位帮忙解决一下这个问题。。不胜感激！

today0427

grf1973 发表于 2017-2-16 09:50
today的做法充分体现了sql的优势，值得学习。
考虑到要分公司统计数量，这样更加好一点。

对的，我当时就想着肯定不止一个单位，所以提问者在给出数据源的时候一定要全面，把所有可能出现的情况都写进去。这样更有利于得到准确适用的代码。

kangkangtianxia

爱疯 发表于 2017-2-14 12:31
Sub test()
    Dim A, B, d, i, j
    Set d = CreateObject("scripting.dictionary")

感谢你的回复！谢谢！

kangkangtianxia

grf1973 发表于 2017-2-15 16:21
代码可以简化一点。

基本达到了我想要的结果。。谢谢你！谢谢！

kangkangtianxia

today0427 发表于 2017-2-15 20:29
鉴于数据源比较规范，我用sql语句也来一个,因为你最后合计的时候按单位合计，而单位为吨的名称都不一样，所 ...

感谢你的回复！谢谢！

kangkangtianxia

grf1973 发表于 2017-2-15 16:21
代码可以简化一点。

基本达到了我想要的结果。。谢谢！

kangkangtianxia

grf1973 发表于 2017-2-15 16:21
代码可以简化一点。

你好，此处加多一个按地区排序怎么弄呢？？谢谢！

grf1973

sql 最后加一句 order by 地区

kangkangtianxia

grf1973 发表于 2017-5-12 13:33
sql 最后加一句 order by 地区

那就是你给出的答案（我设为最佳答案的）里面不能按地区排序？？

kangkangtianxia

grf1973 发表于 2017-5-12 13:33
sql 最后加一句 order by 地区

还有个问题就是运行程序后怎么小于1的值显示为没有小数点前面的的零的？？如“.96吨”

雄鹰2013

Sub 汇总2()
Dim arr, brr, crr
Set d = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
arr = Sheets("数据源").Range("a1").CurrentRegion
ReDim drr(1 To UBound(arr), 1 To 8)
Rows("2:1000").Clear
For i = 2 To UBound(arr)
     zf1 = arr(i, 1)
     zf2 = arr(i, 1) & "," & arr(i, 5)
     zf3 = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 5) & "," & arr(i, 6) & "," & arr(i, 7)
     d(zf1) = d(zf1) + 1
     d2(zf2) = d2(zf2) + arr(i, 4)
     d3(zf3) = d3(zf3) + arr(i, 4)
Next i
brr = d3.keys
crr = d2.keys
For Each k In d.keys
     For i = 0 To UBound(brr)
         If Split(brr(i), ",")(0) = k Then
            n = n + 1
            drr(n, 1) = Split(brr(i), ",")(0)
            drr(n, 2) = Split(brr(i), ",")(1)
            drr(n, 3) = Split(brr(i), ",")(2)
            drr(n, 4) = d3(brr(i))
            drr(n, 5) = Split(brr(i), ",")(3)
            drr(n, 6) = Split(brr(i), ",")(4)
            drr(n, 7) = Split(brr(i), ",")(5)
         End If
     Next i
     For i = 0 To UBound(crr)
         If Split(crr(i), ",")(0) = k Then
            dw = Split(crr(i), ",")(1)
            s = s & d2(crr(i)) & dw & "+"
         End If
     Next i
     r = Sheets("目标结果").Cells(Rows.Count, 1).End(xlUp).Row + 1
     Sheets("目标结果").Cells(r, 1).Resize(n, 8) = drr
     Cells(r, 8) = Mid(s, 1, Len(s) - 1)
     Cells(r, 8).Resize(n).Merge
     s = ""
     n = 0
Next k
End Sub