我要把一个工作表中的数据无重复添加到另一个工作表中

hqmtba · 发表于 2015-1-26 16:04

TomingTang 发表于 2015-1-26 14:29
某个写错了。现在改好了。我的程序运行速度比2楼，当量大时。

非常感谢您的热心帮忙，又进一步让我体会到了VBA的强大，可惜我现在还没办法测试（但是我相信您的代码一定会行的），因为我的电脑在运行一个包含大量函数的工作表，大概要运行两三个小时，这也是我一个一直困扰我得一个问题，也很想用代码来解决，稍晚我也把它贴出来，请求进一步的帮忙！！

hqmtba · 发表于 2015-1-26 16:08

还有个我觉得复杂得多的问题一直困扰我，工作表包含了大量函数，运行一次要几个小时，稍晚一点才能贴出来，因为它正在运行，要是两位能用代码解决，不胜感激！请到时关注，谢谢！

hqmtba · 发表于 2015-1-26 23:47

本帖最后由 hqmtba 于 2015-1-26 23:48 编辑

奇怪，找不到附件按钮，连发新帖也看不到附件按钮了！

hqmtba · 发表于 2015-1-26 23:50

我要对附件中的sheet1中的数据进行统计，因为涉及的数据量很大，运用公式运行需要几个小时，效率很低，这个问题已经困扰我很长时间了，现在想借助于代码的威力来提高效率，敬请老师指教！先谢过！

hqmtba · 发表于 2015-1-26 23:56

TomingTang 发表于 2015-1-26 14:29
某个写错了。现在改好了。我的程序运行速度比2楼，当量大时。

谢谢您的回复，经测试，很有效，让我能从多角度学习了VBA！

hqmtba · 发表于 2015-1-27 00:01

我又参考了9楼老师的代码，加入了按A列排序的代码，太好了！

Sub 添加()
Dim Arr, Brr, drow%, i%, j%, d, Crr(), k%
k = 1
Set d = CreateObject("scripting.dictionary")
Arr = Worksheets("添加").Range("a2:b" & Worksheets("添加").Range("a65536").End(3).Row)
With Worksheets("明细")
drow = .Range("a65536").End(3).Row
Brr = .Range("a2:b" & drow)
For i = 1 To UBound(Brr)
d(Brr(i, 1)) = Brr(i, 2)
Next
ReDim Crr(1 To UBound(Arr), 1 To 2)
For i = 1 To UBound(Arr)
If Not d.exists(Arr(i, 1)) Then
Crr(k, 1) = Arr(i, 1): Crr(k, 2) = Arr(i, 2)
k = k + 1
End If
Next
.Range("a" & drow + 1).Resize(k, 2) = Crr
.Columns("A:B").Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes
End With
End Sub

复制代码

hqmtba · 发表于 2015-1-27 00:03

本帖最后由 hqmtba 于 2015-1-27 10:11 编辑

代码效率太高了，现在静等14楼问题的解决！

蒙蒙烟雪 · 发表于 2015-1-27 11:32

hqmtba 发表于 2015-1-27 00:03
代码效率太高了，现在静等14楼问题的解决！

以万科A为例，C3的大额买单总和为什么不是85104.26（去掉低于1000万的会更少），D3的大额卖单总和为什么不是102093.57？

hqmtba · 发表于 2015-1-27 12:54

第三行实际运行公式结果为：
2 万科Ａ 85104.26 102093.57 -16989.31 0.83 3132.85 3071.5
结果有误应该是在粘贴数据的时候发生了错误，或者是张冠李戴了。

guaxiaodai11 · 发表于 2015-1-27 13:17

收藏學習一下

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

[求助] 我要把一个工作表中的数据无重复添加到另一个工作表中