[已解决]查找数据求助20160131

thelastdance

函数或者VBA求助

最佳答案

月排行榜 / 总排行榜

雪舞子

2016-1-31 16:53

thelastdance 发表于 2016-1-31 16:42
在B2：B45输入结果，C2：C45是B列的模拟结果
引用数据源在表名“开票”

重新写一下，这样对吗？

1. Sub test()
   
2.     Dim d As Object, arr, i&, j&
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheets("开票").Range("a1").CurrentRegion
   
5.     For i = 2 To UBound(arr)
   
6.         d(arr(i, 4)) = d(arr(i, 4)) + arr(i, 3)
   
7.     Next
   
8.     With Sheet1
   
9.         .[b2:b1000] = ""
   
10.         arr = .Range("a1").CurrentRegion
    
11.         For i = 1 To UBound(arr)
    
12.             If d.exists(arr(i, 1)) Then arr(i, 2) = d(arr(i, 1))
    
13.         Next
    
14.         .[a1].Resize(i - 1, 3) = arr
    
15.     End With
    
16.     MsgBox "处理完毕！"
    
17. End Sub

复制代码

查找数据求助20160131（可用VBA）.rar (19.53 KB, 下载次数: 4)

2016-1-31 16:53 上传

点击文件名下载附件

跳转到最佳答案楼层

雪舞子

1. [code]Sub test()
   
2.     Dim d As Object, arr, i&, j&
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Range("a1").CurrentRegion
   
5.     For i = 2 To UBound(arr)
   
6.         d(arr(i, 3)) = d(arr(i, 3)) + arr(i, 2)
   
7.     Next
   
8.     Sheet1.[c2:c1000] = ""
   
9.     arr = Sheet1.Range("a1").CurrentRegion
   
10.     For i = 1 To UBound(arr)
    
11.         If d.exists(arr(i, 1)) Then arr(i, 3) = d(arr(i, 1))
    
12.     Next
    
13.     [a1].Resize(i - 1, 3) = arr
    
14.     MsgBox "处理完毕！"
    
15. End Sub

复制代码

[/code]

查找数据求助20160131（可用VBA）.rar (15.19 KB, 下载次数: 1)

2016-1-31 16:33 上传

点击文件名下载附件

雪舞子

工作表中加上按钮，
方便点击执行。

查找数据求助20160131（可用VBA）.rar (18.03 KB, 下载次数: 1)

2016-1-31 16:34 上传

点击文件名下载附件

thelastdance

雪舞子 发表于 2016-1-31 16:34
工作表中加上按钮，
方便点击执行。

在B2：B45输入结果，C2：C45是B列的模拟结果
引用数据源在表名“开票”

雪舞子

thelastdance 发表于 2016-1-31 16:42
在B2：B45输入结果，C2：C45是B列的模拟结果
引用数据源在表名“开票”

重新写一下，这样对吗？

1. Sub test()
   
2.     Dim d As Object, arr, i&, j&
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheets("开票").Range("a1").CurrentRegion
   
5.     For i = 2 To UBound(arr)
   
6.         d(arr(i, 4)) = d(arr(i, 4)) + arr(i, 3)
   
7.     Next
   
8.     With Sheet1
   
9.         .[b2:b1000] = ""
   
10.         arr = .Range("a1").CurrentRegion
    
11.         For i = 1 To UBound(arr)
    
12.             If d.exists(arr(i, 1)) Then arr(i, 2) = d(arr(i, 1))
    
13.         Next
    
14.         .[a1].Resize(i - 1, 3) = arr
    
15.     End With
    
16.     MsgBox "处理完毕！"
    
17. End Sub

复制代码

查找数据求助20160131（可用VBA）.rar (19.53 KB, 下载次数: 4)

2016-1-31 16:53 上传

点击文件名下载附件