从一张纸到另一张纸的慢速 VBA 宏读/写

Question

我正在编写一个宏，它将评估 O 到 V 列中的字段的 800 行左右。我读过阅读和写作花费的时间最长，这就是我本质上在做的事情。

因为有很多数据，所以运行速度很慢。运行所有内容可能需要一分钟，也许更多一点，它会说 Excel 在运行时没有响应。

我需要一些帮助来优化它，因为我对 VBA 不是很熟悉，但我已经尽我所能来加快速度。我读过使用二维数组会有所帮助，但我不知道在这种情况下如何工作。

任何帮助或建议将不胜感激！谢谢你的时间:-)

Sub Check_Missing()

Application.ScreenUpdating = False

Dim LastRow, LastRow2 As Long
Dim col
Dim i, j, 
Dim M, N, P As String
Dim summarySh, resultsSh As Worksheet

Set summarySh = Sheets("summary")
Set resultsSh = Sheets("Results")

col = Array("O", "P", "Q", "R", "S", "T", "U", "V")
M = "Missing"
N = "No"
P = "Partial"

LastRow = summarySh.Range("A" & Rows.Count).End(xlUp).Row
LastRow2 = resultsSh.Range("A" & Rows.Count).End(xlUp).Row + 1

resultsSh.Range("A2:AC" & LastRow2).Clear

For i = 2 To LastRow
    For j = LBound(col) To UBound(col)
        If summarySh.Cells(i, col(j)).Value = M Or summarySh.Cells(i,             
col(j)).Value = N Or summarySh.Cells(i, col(j)).Value = P Then
            summarySh.Cells(i, col(j)).EntireRow.Copy     
Destination:=resultsSh.Range("A" & Rows.Count).End(xlUp).Offset(1)

            GoTo ContinueForLoop

        End If

    Next j
ContinueForLoop:
Next i
Application.ScreenUpdating = True
End Sub

这是一个附带问题，所以如果你碰巧知道，那就太好了，但如果不知道，我相信我能弄明白。

我必须比较两个工作簿（一个是我正在使用的工作簿，另一个是从外部下载的），我希望调用一个 Excel 加载项函数 Inquire，以便它会立即弹出，如果其他人将使用我的宏，因为它会更加用户友好。

Answer 1

首先，当你在同一行代码中声明多个变量时，你必须这样做：

Dim LastRow As Long, LastRow2 As Long
Dim M As String, N As String, P As String
Dim summarySh As Worksheet, resultsSh As Worksheet

否则，只有该行中的最后一个变量被声明为您想要的类型，而其他变量的类型为Variant。这可能会影响执行速度。尤其是当您必须使用 Long 类型时。

i 和 j 也需要声明为 Long。

Dim i As Long, j As Long

col 应声明为变体：

Dim col() As Variant

请避免使用GoTo 语句。这是一种过时且不好的做法，它使代码难以阅读和维护，并可能导致混乱和不良行为。

您应该使用Do-While 循环而不是For-Next 与GoTo 结合使用。如果我正确理解您的逻辑，您可以执行以下操作：

For i = 2 To LastRow
    j = 0
    Do While j <= UBound(col) And Not (summarySh.Cells(i, col(j)).Value = M Or summarySh.Cells(i, col(j)).Value = n Or summarySh.Cells(i, col(j)).Value = P)
        j = j + 1
    Loop
    If j < UBound(col) + 1 Then
        summarySh.Cells(i, col(j)).EntireRow.Copy Destination:=resultsSh.Range("A" & Rows.Count).End(xlUp).Offset(1)
    End If
Next i

Answer 2

试试这个：

Sub Check_Missing()

    Dim wb As Workbook
    Dim wsSummary As Worksheet
    Dim wsResults As Worksheet
    Dim rFind As Range
    Dim rCopy As Range
    Dim aFindPhrases As Variant
    Dim vPhrase As Variant
    Dim sCheckCols As String
    Dim sFirst As String

    Set wb = ActiveWorkbook
    Set wsSummary = wb.Worksheets("summary")
    Set wsResults = wb.Worksheets("Results")

    sCheckCols = "O:V"  'If getting non-continuous columns, can use this style (for example): "O:O,Q:S,U:V"
    aFindPhrases = Array("Missing", "No", "Partial")

    For Each vPhrase In aFindPhrases
        Set rFind = wsSummary.Range(sCheckCols).Find(vPhrase, , xlValues, xlWhole)
        If Not rFind Is Nothing Then
            sFirst = rFind.Address
            Do
                Select Case (rCopy Is Nothing)
                    Case True:  Set rCopy = rFind.EntireRow
                    Case Else:  Set rCopy = Union(rCopy, rFind.EntireRow)
                End Select
                Set rFind = wsSummary.Range(sCheckCols).FindNext(rFind)
            Loop While rFind.Address <> sFirst
        End If
    Next vPhrase

    wsResults.UsedRange.Offset(1).ClearContents
    If Not rCopy Is Nothing Then rCopy.Copy wsResults.Cells(wsResults.Rows.Count, "A").End(xlUp).Offset(1)

End Sub