按照编号，将第二列数字求和

jinnniuexcel

看了很多帖子有点混乱，还是没搞好，希望大神可以帮忙。
主要是按照编号，将第二列的贷款阅求和。如果编号一样那就把贷款余额加总，后面的数据继续带着。

我写的代码
Dim arr, d As Object, nr&, i&, m&
nr = Sheet26.Range("a65536").End(xlUp).Row
arr = Sheet26.Range("a5").Resize(nr, 6)
Set d = CreateObject("scripting.dictionary")
For i = 1 To nr - 1
d(arr(i, 1)) = Array(arr(i, 1), d(arr(i, 1)) + arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5), arr(i, 6))
Next i
Range("i1").CurrentRegion.Offset(1).ClearContents
m = d.Count
Range("I2").Resize(m) = Application.Transpose(d.keys)
Range("J2").Resize(m) = Application.Transpose(d.Items)
Set d = Nothing

老是提示  d(arr(i, 1)) = Array(arr(i, 1), d(arr(i, 1)) + arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5), arr(i, 6)) 这句有问题
不知道为什么，谢谢了

jinnniuexcel

删除，数据已经长传

jinnniuexcel

不知道为什么无法上传附件，还请帮忙看一下是为什么，谢谢了

一把小刀闯天下

'没有你这样用字典的。先判断字典键值是否存在，否->写入键值，数组放入item。是->item给一个数组t，在数组t中累加后再存入字典当前item
'按我的方法给你写一个吧，效率可能更高点的

Option Explicit

Sub test()
  Dim i, j, n, arr, dic
  arr = [a4].CurrentRegion
  Set dic = CreateObject("scripting.dictionary")
  For i = 2 To UBound(arr, 1)
    If dic.exists((arr(i, 1))) Then
      arr(dic(arr(i, 1)), 2) = arr(dic(arr(i, 1)), 2) + arr(i, 2)
    Else
      n = n + 1: dic(arr(i, 1)) = n
      For j = 1 To UBound(arr, 2): arr(n, j) = arr(i, j): Next
    End If
  Next
  With [i5]
    .Resize(Rows.Count - 4, UBound(arr, 2)).ClearContents
    If n > 0 Then .Resize(n, UBound(arr, 2)) = arr
  End With
End Sub

jinnniuexcel

一把小刀闯天下 发表于 2018-6-16 04:27
'没有你这样用字典的。先判断字典键值是否存在，否->写入键值，数组放入item。是->item给一个数组t，在数组 ...

谢谢您的回复，学习到了 ，，感谢感谢