加快处理Excel VBA中的大量数据

我正在使用vba获取不同货币的不同帐户的列表。 为此,我使用常规筛选器来select货币,然后使用高级筛选器为货币挑选出所有帐户。 然后它将这个列表粘贴在名为Accts的表上。

电子表格有超过3万行信息,速度非常缓慢。 我的代码如下。 我认为它的工作,但只是永远。

Sub Filtering() Application.ScreenUpdating = False intLastRow = Worksheets("report").Cells(Rows.Count, "b").End(xlUp).Row intLastCol = Worksheets("info sheet").Cells(Columns.Count, 7).Column Set rngAdvFilter = Worksheets("report").Range("b7:m" & intLastRow) Set rngCriteria = Worksheets("report").Range("d7:d" & intLastRow) Set rRange = Worksheets("info sheet").Range("c7:m7") For Each rCell In rRange strCurrency = rCell.Value With rngAdvFilter .AutoFilter Field:=6, Criteria1:= _ "=" & strCurrency, Operator:=xlAnd 'filtering on currency so we are 'looking for all accounts on a certain currency End With Worksheets("accts").Select Range("b1:aa1").Select Selection.find(What:=strCurrency, After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Activate Set rngPaste = ActiveCell.Offset(1, 0) rngPaste.Select Worksheets("report").Select Range("D7:D" & intLastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _ "P7"), Unique:=True intLastRow2 = Worksheets("report").Cells(Rows.Count, "p").End(xlUp).Row Set rngResults = Worksheets("report").Range("P8:P" & intLastRow2) rngResults.Copy rngPaste.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False rngResults.ClearContents If Worksheets("report").FilterMode Then Worksheets("report").ShowAllData End If Next rCell Application.ScreenUpdating = True End Sub 

我想你可能需要做一些重写。 每个细胞的select是真正放慢速度的东西。 我build议从这里开始如何避免使用在Excel VBAmacros中select

我也build议声明所有的variables(在你的模块的顶部也放上“Option Explicit”)Lea。

这肯定会跑得很慢。 每次访问电子表格(范围访问),它都会减慢速度。 要做到这一点的方法是通过访问该表只执行两次。 一次获取数据,另一次把所需的东西放回到工作表上。

例如

 Sub ProcessData() Dim Rng as Range, OutputRng as Range Set Rng = Worksheets("Sheet1").Range("A1:D20000") ' Spreadsheet Access # 1 ' Assuming you want to do something to the data in that range Dim InputDat as Variant, OutputDat() as Variant InputDat = Rng ' Now InputDat has become a Variant array of size 20000 x 4 ' Code to manipulate Dat goes here Redim OutputDat(1 to 100, 1 to 4) 'Or dynamically as needed ' Put required output data into OutputDat as if it's the range ' where your answers appear following the correct row/column number Set OutputRng = Worksheets("Sheet2").Range("A1:D100") OutputRng = OutputDat ' Spreadsheet access #2 End Sub 

这会加速几个数量级。 此外,通常的Application.Screenupdating等可能会有所帮助,这取决于你在macros中做了什么,但考虑到屏幕上没有太多的事情,只有2次访问,这应该是非常快的。