运行这个宏好慢，远比公式来的慢，为什么？能不能加快处理速度？

AVEL

1. 
   
2. 
   
3. Sub yy()
   
4.     Dim Arr, i&, Arr1, r1, Arr2
   
5.     Dim d As Object, d1 As Object
   
6.     Dim j As Integer, m As Integer
   
7.     Dim brr(1 To 10000, 1 To 64), crr(1 To 10000, 1 To 64)
   
8.     Dim n As Integer
   
9.     Dim r As Integer
   
10.     Myr = Sheet3.[a65536].End(xlUp).Row
    
11.     Arr = Sheet3.Range("a1:bo" & Myr)
    
12.     Set d = CreateObject("scripting.dictionary")
    
13.         Set d1 = CreateObject("scripting.dictionary")
    
14.     For i = 2 To UBound(Arr)
    
15.         d(Split(Arr(i, 2), "_")(1)) = i
    
16.         d1(Arr(i, 2)) = i
    
17.     Next
    
18.     Arr1 = Sheet1.[c1].Resize(Sheet1.[c65536].End(3).Row)
    
19.     Arr2 = Sheet2.[d1].Resize(Sheet2.[d65536].End(3).Row)
    
20.     For i = 2 To UBound(Arr1)
    
21.         n = n + 1
    
22.         If d.exists(CStr(Arr1(i, 1))) Then
    
23.             r = d(CStr(Arr1(i, 1)))
    
24.             For j = 4 To Arr(r, 3) + 3
    
25.                 brr(n, j - 3) = Arr(r, j)
    
26.             Next
    
27.         End If
    
28.     Next
    
29.     For i = 2 To UBound(Arr2)
    
30.         m = m + 1
    
31.         If d1.exists(CStr(Arr2(i, 1))) Then
    
32.             r = d1(CStr(Arr2(i, 1)))
    
33.             For j = 4 To Arr(r, 3) + 3
    
34.                 crr(m, j - 3) = Arr(r, j)
    
35.             Next
    
36.         End If
    
37.     Next
    
38.     Sheet2.Range("e2").Resize(m, 64).Value = crr
    
39.     Sheet1.Range("k2").Resize(n, 64).Value = brr
    
40.     Set d = Nothing: Set d1 = Nothing
    
41. End Sub

复制代码

AVEL

复件 Book2 11-12-18 23-05.rar (17.52 KB, 下载次数: 35)

2011-12-18 23:06 上传

点击文件名下载附件

leifashen

{:soso_e120:}有点像邻区列表

dtdfex

AVEL 发表于 2011-12-18 23:07

老大，帮把这两个计算分开来吧，我有点晕了。如果我需要一个表一个表的提取呢？学习中，真比公式快很多了，谢谢

szwzq

1. Sub tt()
   
2.     Dim d As Object, i&, j&, ar, arr()
   
3.     Dim s
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     ar = Sheet3.Range("b2:bo" & Sheet3.[b65536].End(3).Row)
   
6.     For i = 1 To UBound(ar)
   
7.         For j = 3 To 66
   
8.             s = s & "," & ar(i, j)
   
9.         Next
   
10.         d(ar(i, 1)) = s
    
11.         s = 0
    
12.     Next
    
13.     ar = Sheet2.Range("d2", Sheet2.[d65536].End(3))
    
14.     ReDim arr(1 To UBound(ar), 1 To 64)
    
15.     For i = 1 To UBound(ar)
    
16.         For j = 1 To 64
    
17.             arr(i, j) = Split(d(ar(i, 1)), ",")(j)
    
18.         Next
    
19.     Next
    
20.     Sheet1.[k2].Resize(UBound(arr), 64) = arr
    
21. End Sub

复制代码

dtdfex

{:soso_e181:}{:soso_e183:}
{:soso_e181:}{:soso_e183:}
{:soso_e181:}{:soso_e183:}
{:soso_e181:}{:soso_e183:}

dtdfex

AVEL 发表于 2011-12-18 23:07

复件 Book2.rar (6.43 KB, 下载次数: 22)

2011-12-19 09:50 上传

点击文件名下载附件

搞不明白，这个，再请教一下，并说明原因，谢谢！

    Dim r As Integer
    Myr = Sheet4.[a65536].End(xlUp).Row
    arr = Sheet4.Range("a1:bo" & Myr)
    Set d = CreateObject("scripting.dictionary")
        Set d1 = CreateObject("scripting.dictionary")

老大，"a1:bo"是第二行开始的吗？如果我是顶格，哪怎么样用？
提示下标越界。

Zamyi

灰袍法师 发表于 2011-12-18 21:59
刚好相反
VBA必然比公式快成百上千倍
楼主的问题在于，写VBA，却调用公式，等于用手推着汽车跑，当然慢 ...

并非所有公式比不上VBA，如求一单元格区域的和：

1. Sub test()
   
2. t = Timer
   
3. [b1] = Application.WorksheetFunction.Sum([a1:a1000000])
   
4. [e1] = Timer - t
   
5. t = Timer
   
6. For Each c In Range("a1:a1000000").Value
   
7. s = s + c
   
8. Next
   
9. [b2] = s
   
10. [e2] = Timer - t
    
11. End Sub

复制代码

一楼慢的原因在于Find、Index和Cells(i, 28).Resize(1, UBound(Arr, 2)) 都是循环操作对象，速度自然慢。同理也适应于工作式，之所以数组公式很慢，原因它是引用大量的单元格，实际上操作对象，而VBA可以尽量地减少操作对象，速度才得以提升。二楼可以说VBA根本未入门。{:soso_e120:}

wpxxsyzx

coolboy 发表于 2011-12-18 21:16
VBA必然会比公式慢很多的，能用公式解决的最好不用VBA，
公式的运算编译次数应该比VBA简洁很多，执行效率自 ...

VBA必然会比公式慢很多的，能用公式解决的最好不用VBA
不同意此看法

灰袍法师

Zamyi 发表于 2011-12-19 19:04
并非所有公式比不上VBA，如求一单元格区域的和：
一楼慢的原因在于Find、Index和Cells(i, 28).Resize(1, ...

如果把VBA代码做到最优
先声明变量为long或者double，先把多行一列的两维数组转为一行多列的一维数组
VBA代码的速度会快10倍，变成跟调用 application.sum 一样快。
话说，公式也就在这么简单的问题能够跟VBA比一下速度，稍微复杂的问题，速度就差远了。
Option Explicit

Sub 按钮1_Click()
Dim t, c As Double, s As Double, arr, arr2() As Double, i As Long

t = Timer

[b1] = Application.WorksheetFunction.Sum([a1:a1000000])

[e1] = Timer - t

arr = Range("a1:a1000000").Value
ReDim arr2(1 To 1000000)
For i = 1 To 1000000
arr2(i) = arr(i, 1)
Next i
t = Timer

For i = 1 To 1000000

s = s + arr2(i)

Next

[b2] = s

[e2] = Timer - t

End Sub