如何用vba代码将一列有重复数据的值提取一个出来，并此唯一值对应的字段进行加总？

蒋晓丹

各位老师好：
    请问怎么才能从用vba代码从一组有重复数据的列中提取一个唯一的值，然后将这个值对应得字段进行加总然后显示出来。

smhf_6

这个是临时使用？ 还是代码中间经常需要使用？
若前者： 用数据-删除重复项，是非常的方便， 本人经常复制这1列或2列到 新表中（这样不破坏原表）使用该功能

若是后者，用字典是统计可以了
for i=1 to 100
if dc.exists(xx)=false then
  dc(xx)=""
  msum=msum+yy
end if
next

jsgj2023

楼主连具体说明都没给？

kszcs

哪列有重复的？汇总哪列？

蒋晓丹

kszcs 发表于 2016-12-27 14:39
哪列有重复的？汇总哪列？

我重新把想实现的结果做成了图示，请您再帮我看看，谢谢哈！

蒋晓丹

jsgj2023 发表于 2016-12-26 20:12
楼主连具体说明都没给？

我重新把具体说明做成了图示，请您再帮忙看看，谢谢。

蒋晓丹

smhf_6 发表于 2016-12-26 18:18
这个是临时使用？ 还是代码中间经常需要使用？
若前者： 用数据-删除重复项，是非常的方便， 本人经常复制 ...

是想做成一个模板，这个表是审计底稿，之前全部是用函数计算的，由于数据量很大，所以每次运行都特别慢，所以想用vba进行改进，我用字典试了，总是出现bug，自己也没调明白。

smhf_6

Sub fjsgfh()
Dim i, ir, m, arr, brr(), tt
Dim dc As Object
Set dc = CreateObject("scripting.dictionary")
tt = Timer
ir = Range("a1").End(xlDown).Row
arr = Range("a2:l" & ir + 1)
For i = 1 To ir - 1
   If arr(i, 3) = arr(i + 1, 3) Then
        If dc.exists(arr(i, 3)) = False Then
        dc(arr(i, 3)) = ""
        m = m + 1
        ReDim Preserve brr(1 To 11, 1 To m)
        brr(1, m) = arr(i, 1) & arr(i, 2)
        brr(2, m) = arr(i, 3)
        brr(3, m) = arr(i, 4)
        brr(4, m) = arr(i, 5)
        brr(5, m) = arr(i, 6)
        brr(6, m) = arr(i, 7)
        brr(7, m) = arr(i, 8)
        brr(8, m) = arr(i, 9)
        Else
        brr(7, m) = brr(7, m) + arr(i, 8)
        brr(8, m) = brr(8, m) + arr(i, 9)
        End If
   Else
        If dc.exists(arr(i, 3)) = False Then
        m = m + 1
        ReDim Preserve brr(1 To 11, 1 To m)
        brr(1, m) = arr(i, 1) & arr(i, 2) & "-" & arr(i, 1) & arr(i, 2)
        brr(2, m) = arr(i, 3)
        brr(3, m) = arr(i, 4)
        brr(4, m) = arr(i, 5)
        brr(5, m) = arr(i, 6)
        brr(6, m) = arr(i, 7)
        brr(7, m) = arr(i, 8)
        brr(8, m) = arr(i, 9)
        brr(9, m) = arr(i, 10)
        brr(10, m) = arr(i, 11)
        brr(11, m) = arr(i, 12)
        Else
        brr(1, m) = brr(1, m) & "-" & arr(i, 1) & arr(i, 2)
        brr(7, m) = brr(7, m) + arr(i, 8)
        brr(8, m) = brr(8, m) + arr(i, 9)
        brr(9, m) = arr(i, 10)
        brr(10, m) = arr(i, 11)
        brr(11, m) = arr(i, 12)
        End If
   End If
Next
ir = Sheet1.Range("a100000").End(xlUp).Row
If ir > 2 Then
Sheet1.Range("a2:k" & ir).ClearContents
End If
   Sheet1.Range("a2").Resize(m, 11) = Application.WorksheetFunction.Transpose(brr)
   MsgBox ("统计完成用时：" & Timer - tt & "秒")
   Set dc = Nothing
End Sub

smhf_6

楼主最后做出的模板，与开始说的完全是两回事，虽然代码中仍用到了字典，但使用的含义与原先的回答也就不同了。
另外，由于每个编号下数量是不确定的，除非做两次循环，先统计每个编号的数量，但现在没有这样做。
楼主必须先按编号-日期排序，否则结果也是错的
代码，是通过数组循环处理的，没有什么新鲜的内容。

smhf_6

不过，循环2次其实也不方便，虽然统计了每个编号的总数量，还要考虑每个编号的最后日期，因为每个编号的最后日期并不相同，所以，想想还是排序吧，排序正确后，就可以直接判断了。