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

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

2 个答案: