用纯数组方法去重汇总

Justin-2016 · 发表于 2024-7-10 11:32

本帖最后由 Justin-2016 于 2024-7-10 12:00 编辑

liulang0808 · 发表于 2024-7-10 11:52

Sub 按钮1_Click()
arr = [a1].CurrentRegion
r = 1
For j = 2 To UBound(arr)
      For i = 2 To r
         If arr(i, 1) = arr(j, 1) Then
            arr(i, 2) = arr(i, 2) + arr(j, 2)
            GoTo l1
         End If
      Next i
      r = r + 1
      If r <> j Then
         For i = 1 To UBound(arr, 2)
            arr(r, i) = arr(j, i)
         Next i
      End If
l1:
Next j
[f1].Resize(r, 2) = arr
End Sub

liulang0808 · 发表于 2024-7-10 11:53

。。。。。。。。。。。。。。。。。

Justin-2016 · 发表于 2024-7-10 11:58

liulang0808 发表于 2024-7-10 11:53
。。。。。。。。。。。。。。。。。

想学下另一种解决思路，数组+字典解决已经会了

zhangcheng6688 · 发表于 2024-7-10 12:21

liulang0808 发表于 2024-7-10 11:52
Sub 按钮1_Click()
arr = [a1].CurrentRegion
r = 1

用纯数组方法去重汇总，学习留底

quqiyuan · 发表于 2024-7-10 12:40

参与一下，供参考。。。

quqiyuan · 发表于 2024-7-10 12:41

代码如下：

Sub test()
ReDim brr(1 To 1000, 1 To 2)
n = 1
With Sheet1
      arr = .[a1].CurrentRegion
      brr(1, 1) = arr(2, 1)
      brr(1, 2) = arr(2, 2)
      For i = 3 To UBound(arr)
         t = False
         For j = 1 To n
            If brr(j, 1) = arr(i, 1) Then
                  brr(j, 2) = brr(j, 2) + arr(i, 2)
                  t = True
                  Exit For
            End If
         Next
         If t = False Then
            n = n + 1
            brr(n, 1) = arr(i, 1)
            brr(n, 2) = arr(i, 2)
         End If
      Next
      .[f2].Resize(n, 2) = brr
End With
Beep
End Sub

cai2532 · 发表于 2024-7-10 17:00

这个实例学习了。

无关岁月 · 发表于 2024-7-10 17:37

副本用纯数组方法去重汇总.7z (17.07 KB, 下载次数: 12)

屏幕截图 2024-07-10 173556.png

一招秒杀 · 发表于 2024-7-10 19:46

这么简单的内容，简单两个公式就搞好了，为什么要写那才以多的VBA代码，真要人老命。
如果是 SQL 1句就可以搞定了，

Select 编号,Sum(数量) 数量 From @T Group By 编号

复制代码

		自动登录	找回密码
密码			免费注册

[已解决] 用纯数组方法去重汇总

评分

评分

评分