|
4#
楼主 |
发表于 2008-1-12 12:57:43
|
只看该作者
谢谢欢欢,搞定,回去测试一下几万条大数据量的速度。另外su45写的代码如何?哪种速度会快些?
Sub suaa()
Dim arr1(), arr2(), arr3()
r = [A65536].End(xlUp).Row
rng1 = Range("A2:A" & r)
rng2 = Range("A2:E" & r)
With Sheets("期末余额表")
r = .[A65536].End(xlUp).Row
rng3 = .Range("A2:A" & r)
rng4 = .Range("A2:E" & r)
End With
rng1 = Application.Transpose(rng1)
rng3 = Application.Transpose(rng3)
For i = 1 To UBound(rng3)
If UBound(Filter(rng1, rng3(i))) > -1 Then
n = n + 1
ReDim Preserve arr3(1 To 5, 1 To n)
For j = 1 To 5
arr3(j, n) = rng4(i, j)
Next
Else
m = m + 1
ReDim Preserve arr2(1 To 5, 1 To m)
For j = 1 To 5
arr2(j, m) = rng4(i, j)
Next
End If
Next
For i = 1 To UBound(rng1)
If UBound(Filter(rng3, rng1(i))) = -1 Then
k = k + 1
ReDim Preserve arr1(1 To 5, 1 To k)
For j = 1 To 5
arr1(j, k) = rng2(i, j)
Next
End If
Next
With Sheets("减少的客户名单")
r = .[A65536].End(xlUp).Row
If r > 2 Then .Range("A3:C" & r).ClearContents
.[A3].Resize(k, 5) = Application.Transpose(arr1)
End With
With Sheets("新增的客户名单")
r = .[A65536].End(xlUp).Row
If r > 2 Then .Range("A3:C" & r).ClearContents
.[A3].Resize(m, 5) = Application.Transpose(arr2)
End With
With Sheets("老客户名单")
r = .[A65536].End(xlUp).Row
If r > 2 Then .Range("A3:C" & r).ClearContents
.[A3].Resize(n, 5) = Application.Transpose(arr3)
End With
End Sub
[ 本帖最后由 海孩 于 2008-1-12 13:59 编辑 ] |
|