arrays上的VBA运行速度太慢

我所处理的文件包含大约80,000行

我需要执行一些基本检查，并将结果复制到新工作表中。 整个事情大概需要8分钟，我想它太长了，有没有更快的方法？

Application.Calculation = xlCalculationManual Application.ScreenUpdating = False lastCell = checkbook.UsedRange.Rows.Count ReDim dataArray(2 To lastCell, 1 To 4) For i = 2 To lastCell dataArray(i, 1) = checkbook.Range(streetAddress & i).Value dataArray(i, 2) = checkbook.Range(cityAddress & i).Value dataArray(i, 3) = checkbook.Range(stateAddress & i).Value dataArray(i, 4) = checkbook.Range(postCodeAddress & i).Value Next I For i = 2 To lastCell If dataArray(i, 1) = "" Then results.Range("A" & results.UsedRange.Rows.Count + 1 & ":" & lastCol & results.UsedRange.Rows.Count + 1).Value = checkbook.Range("A" & i & ":" & lastCol & i).Value results.Range(commentAddress & results.UsedRange.Rows.Count).Value = "BLANK Street" End If If dataArray(i, 2) = "" Then results.Range("A" & results.UsedRange.Rows.Count + 1 & ":" & lastCol & results.UsedRange.Rows.Count + 1).Value = checkbook.Range("A" & i & ":" & lastCol & i).Value results.Range(commentAddress & results.UsedRange.Rows.Count).Value = "BLANK City" End If If dataArray(i, 3) = "" Then results.Range("A" & results.UsedRange.Rows.Count + 1 & ":" & lastCol & results.UsedRange.Rows.Count + 1).Value = checkbook.Range("A" & i & ":" & lastCol & i).Value results.Range(commentAddress & results.UsedRange.Rows.Count).Value = "BLANK State" End If If dataArray(i, 4) = "" Then results.Range("A" & results.UsedRange.Rows.Count + 1 & ":" & lastCol & results.UsedRange.Rows.Count + 1).Value = checkbook.Range("A" & i & ":" & lastCol & i).Value results.Range(commentAddress & results.UsedRange.Rows.Count).Value = "BLANK PostCode" End If Next i Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True 

Answer 1

我感到你的痛苦，我也有这样的一张床单。 逐个单元格工作将会很慢。

尝试：

1）你可以尝试复制整个工作表，而不是逐个单元格，所以你有一个备份之前处理你的空白。

我可以使用一些旧代码进行修改，一次性复制整个范围，并将值放在一张全新的表格中：

 Dim s1 As Worksheet Dim s2 As Worksheet Set s1 = ThisWorkbook.Sheets(strSourceSheet) ' What is range of source data lastrow = s1.UsedRange.Rows.Count lastcol = s1.UsedRange.Columns.Count ' copy across s1.Range(s1.Cells(1, 1), s1.Cells(lastrow, lastcol)).Copy ' Create new empty worksheet for holding values Set s2 = Worksheets.Add s2.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, SkipBlanks:=True Application.CutCopyMode = False ' You can rename this s2 sheet 

2）然后尝试search每个列中的空白单元格并执行REPLACE 。 （使用macroslogging器来帮助获取语法）。

在下面的一些示例代码中，您需要通过设置范围而不是使用整列上的select（这将在最后一行之下添加空白）来清除此范围。

 ' go through each of your columns. Did street example here Columns("A:A").Select Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Activate ActiveCell.Replace What:="", Replacement:="BLANK street", LookAt:=xlWhole _ , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False 

希望这可以帮助。 你似乎知道如何编码，但如果你卡住了，然后让我知道。

Answer 2

我find了这个问题的答案

代替

 results.Range(commentAddress & results.UsedRange.Rows.Count) 

定义例如j，并迭代它，每次你增加新的价值表

 results.Range("A" & k & ":" & lastCol & k ).Value = checkbook.Range("A" & i & ":" & lastCol & i).Value results.Range(commentAddress & k).Value = "BLANK Street" k = k + 1 

从8分钟到5秒:)

Answer 3

根据我的知识，一张表到遍历总是一个时间的过程。

1. 我会build议使用数组来保存检查的细节，然后在分配值时使用它们。

    results.Range("A" & results.UsedRange.Rows.Count + 1 & ":" & lastCol & results.UsedRange.Rows.Count + 1).Value = array(Value) 

2. 另一个build议是仅在数组分配期间识别空白单元格，并将这些位置存储在单独的数组中。 所以直接你可以遍历只有空值，而不是通过你所有的80,000