你可能不知道的VBA加速技巧

嫦娥仙子

看君一编贴，胜读十年书啊！谢谢分享！

cxddx0

受益受益

ch12

有一个疑问!

在你的第5讲中,用数组,取数据,确定很快, 可是如果我要赋值到另一个工作表中的速度好像差不多了.

Sub Test2() Dim i As Long, j As Long, buf As Long, C As Variant Application.ScreenUpdating = False Sheets(2).Cells.ClearContents t1 = Time C = Range("A1:CV10000") For i = 1 To 10000 For j = 1 To 100 Worksheets(2).Cells(i, j).Value = C(i, j) Next j Next i Application.ScreenUpdating = True MsgBox Minute(Time - t1) & "分" & Second(Time - t1) & "秒" End Sub

我这里最少需要50秒,不知没有更好的方法????

而这个

Sub Test1() Dim i As Long, j As Long, buf As Long Application.ScreenUpdating = False Sheets(2).Cells.ClearContents t1 = Time For i = 1 To 10000 For j = 1 To 100 Worksheets(2).Cells(i, j).Value = Cells(i, j) Next j Next i Application.ScreenUpdating = True MsgBox Minute(Time - t1) & "分" & Second(Time - t1) & "秒" End Sub

最少需要59秒,好像都差不多啊,

数组的优势也没出来啊!

不知有没有更好的写法???

[此贴子已经被作者于2005-9-8 0:34:23编辑过]

saphxj

精辟！谢谢！

lijinlong

好！学习！几种都用过，但那个快点还真不知道！

hzynew

看了楼主的第5讲，想套用，但不会，不知如何才能让下面这个宏运行得更快？

Sub LBLaw() On Error Resume Next Application.ScreenUpdating = False Range("A3:F203,G4:G203").ClearContents If Cells(1, 12) = "" Or Cells(1, 19) = "" Or Cells(1, 26) = "" Then Exit Sub Else For i = 1 To 6 If i < Cells(1, 19) Then: cb = i + 2: Else cb = i + 3 For j = 1 To Cells(1, 26) If Cells(1, 12) = 1 Then Cells(j + 2, i).FormulaR1C1 = Application.WorksheetFunction.Index(Sheets(1).Columns(cb), Application.WorksheetFunction.Count(Sheets(1).Columns(9)) - (Cells(1, 26) - 2 - j)) Else If Cells(1, 19) = 7 Then Cells(j + 2, i).FormulaR1C1 = Application.WorksheetFunction.Large(Sheets(1).Range("C" & Application.WorksheetFunction.Count(Sheets(1).Columns(9)) - (Cells(1, 26) - 2 - j) & ":H" & Application.WorksheetFunction.Count(Sheets(1).Columns(9)) - (Cells(1, 26) - 2 - j)), 7 - i) Else If i < Cells(1, 19) Then Cells(j + 2, i).FormulaR1C1 = Application.WorksheetFunction.Large(Sheets(1).Range("C" & Application.WorksheetFunction.Count(Sheets(1).Columns(9)) - (Cells(1, 26) - 2 - j) & ":H" & Application.WorksheetFunction.Count(Sheets(1).Columns(9)) - (Cells(1, 26) - 2 - j)), 7 - i) Else If i < 6 Then cc = i + 1 Cells(j + 2, i).FormulaR1C1 = Application.WorksheetFunction.Large(Sheets(1).Range("C" & Application.WorksheetFunction.Count(Sheets(1).Columns(9)) - (Cells(1, 26) - 2 - j) & ":H" & Application.WorksheetFunction.Count(Sheets(1).Columns(9)) - (Cells(1, 26) - 2 - j)), 7 - cc) Else Cells(j + 2, i).FormulaR1C1 = Application.WorksheetFunction.Index(Sheets(1).Columns(9), Application.WorksheetFunction.Count(Sheets(1).Columns(9)) - (Cells(1, 26) - 2 - j)) End If End If End If End If Next Next If Cells(1, 12) = 1 Or Cells(1, 19) = 7 Then With ActiveSheet.Range("G4") For i = 1 To Cells(1, 26) - 1 .Cells(i, 1).Value = Application.WorksheetFunction.Index(Sheets(1).Columns(Cells(1, 19) + 2), Application.WorksheetFunction.Count(Sheets(1).Columns(Cells(1, 19) + 2)) - (Cells(1, 26) - 3 - i)) Next End With Else With ActiveSheet.Range("G4") For i = 1 To Cells(1, 26) .Cells(i, 1).Value = Application.WorksheetFunction.Large(Sheets(1).Range("C" & Application.WorksheetFunction.Count(Sheets(1).Columns(9)) - (Cells(1, 26) - 3 - i) & ":H" & Application.WorksheetFunction.Count(Sheets(1).Columns(9)) - (Cells(1, 26) - 3 - i)), 7 - Cells(1, 19)) Next End With End If End If Range("A1").Select Application.ScreenUpdating = True End Sub

qgng

经典帖，学习中，并期待后续……

lgcmeli

jingdian.

liusjie

经典之作！

rumour

咀嚼中