Question

我处理的文件包含大约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）然后在每列中尝试搜索空白单元格并执行 REPLACE 。（使用宏录制器来帮助获取语法）。

下面的一些示例代码，您需要通过设置范围而不是使用整列上的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

我找到了问题的答案

而不是

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

根据我的知识，Sheet to Sheet Traverse始终是一个时间过程。

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

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

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

阵列上的VBA运行速度太慢

3 个答案: