在 Excel 中使用 VBA 循环遍历范围

Looping through range using VBA in Excel

提问by Gaffi

I have a block of code that takes way too long to process for some files. Smaller files (fewer lines of data) work fine, but once I get to about 150-300, it starts to get slow, (sometimes I think the whole process actually just hangs) and I have to run this sometimes on files with up to 6,000.

我有一段代码需要很长时间来处理某些文件。较小的文件（较少的数据行）可以正常工作，但是一旦我达到大约 150-300，它就会开始变慢（有时我认为整个过程实际上只是挂起）并且我有时必须在文件上运行它6,000。

I want to plug in a VLookup()function in the .FormulaR1C1for a number of cells. I know that I can set the whole range at once using .Range("J2:J" & MaxRow). However, I am looping through a block of cells to check the value of those cells. IFthey are empty, THENI want to apply the formula. If those cells already have values, then I don't want to change them, so I don't think the whole range option will work for me (at least I was unable to get it right).

我想在多个单元格中插入一个VLookup()函数.FormulaR1C1。我知道我可以使用.Range("J2:J" & MaxRow). 但是，我正在遍历一个单元格块以检查这些单元格的值。如果它们是空的，那么我想应用公式。如果这些单元格已经有值，那么我不想更改它们，所以我认为整个范围选项对我不起作用（至少我无法正确设置）。

Private Sub PullMIAFinalizedData(NewMIARep As Worksheet, MaxRow As Long, wkbFinalized As Workbook)

Dim wksFinalized As Worksheet
Dim lCount As Long
Dim sVLookupJBlock As String
Dim sVLookupKBlock As String

    Application.Calculation = xlCalculationManual

    sVLookupJBlock = "=IF(ISERROR(" & _
        "VLOOKUP(RC1,'[" & wkbFinalized.Name & "]" & wksFinalized.Name & "'!C1:C13,13,FALSE))," & _
        Chr(34) & Chr(34) & _
        ",VLOOKUP(RC1,'[" & wkbFinalized.Name & "]" & wksFinalized.Name & "'!C1:C13,13,FALSE))"
    sVLookupKBlock = "=IF(ISERROR(" & _
        "VLOOKUP(RC1,'[" & wkbFinalized.Name & "]" & wksFinalized.Name & "'!C1:C3,3,FALSE))," & _
        Chr(34) & Chr(34) & _
        ",VLOOKUP(RC1,'[" & wkbFinalized.Name & "]" & wksFinalized.Name & "'!C1:C3,3,FALSE))"

    For Each wksFinalized In wkbFinalized.Sheets

        ShowAllRecords wksFinalized 'Custom Function to unhide/unfilter all data

        With NewMIARep

            For lCount = 2 To MaxRow

                If .Range("J" & lCount).value = "" And .Range("K" & lCount).value = "" Then
                    .Range("J" & lCount).FormulaR1C1 = sVLookupJBlock
                    .Range("K" & lCount).FormulaR1C1 = sVLookupKBlock

                    Application.Calculate

                    With .Range("J" & lCount & ":K" & lCount)
                        .value = .value
                    End With


                End If
            Next lCount

            .Range("J2:J" & MaxRow).NumberFormat = "mm/dd/yyyy"

        End With

    Next wksFinalized

    Application.Calculation = xlCalculationAutomatic

End Sub

Am I just stuck with this?

我只是坚持这个吗？

回答by Gaffi

Thanks very much to assyliasand Siddharth Routfor helping out with this; both provided very useful information, which led to this result:

非常感谢assylias和Siddharth Rout帮助解决这个问题；两者都提供了非常有用的信息，导致了这个结果：

Private Sub PullMIAFinalizedData(NewMIARep As Worksheet, MaxRow As Long, wkbFinalized As Workbook)

Dim wksFinalized As Worksheet
Dim lCount As Long
Dim lFinMaxRow As Long
Dim DataRange As Variant 'per assylias, using a variant array to run through cells
Dim FoundRange As Range
    Application.Calculation = xlCalculationManual
    With NewMIARep
        DataRange = .Range("J2:K" & MaxRow)
        For Each wksFinalized In wkbFinalized.Sheets
            ShowAllRecords wksFinalized
            lFinMaxRow = GetMaxRow(wksFinalized)
            If lFinMaxRow > 1 Then
                For lCount = 1 To MaxRow - 1
                    If Len(DataRange(lCount, 1)) = 0 And Len(DataRange(lCount, 2)) = 0 Then
                        'per Siddharth Rout, using Find instead of VLookup
                        Set FoundRange = wksFinalized.Range("A2:A" & lFinMaxRow).Find(What:=.Range("A" & lCount).value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
                        If Not FoundRange Is Nothing Then
                            DataRange(lCount, 1) = FoundRange.Offset(ColumnOffset:=12).value
                            DataRange(lCount, 2) = FoundRange.Offset(ColumnOffset:=2).value
                            Set FoundRange = Nothing
                        End If
                    End If
                Next lCount           
            End If
        Next wksFinalized
    .Range("J2:K" & MaxRow).value = DataRange
    .Range("J2:J" & MaxRow).NumberFormat = "mm/dd/yyyy"
    End With

    Application.Calculation = xlCalculationAutomatic

End Sub

回答by assylias

You don't want to iterate on cells from VBA: it is EXTREMELYslow. Instead, you put the data you need into an array, work on the array and put the data back to the sheet. In your case, something like the code below (not tested):

你不想遍历从VBA细胞：它是EXTREMELY慢。相反，您将需要的数据放入一个数组中，处理该数组并将数据放回工作表中。在您的情况下，类似于下面的代码（未测试）：

Dim data as Variant
Dim result as Variant
Dim i as Long
data = ActiveSheet.UsedRange

ReDim result(1 To UBound(data,1), 1 To UBound(data,2)) As Variant

For i = LBound(data,1) to UBound(data,1)
    'do something here, for example
    If data(i,1) = "" Then
        result(i,1) = "=VLOOKUP($A1,$A:$G," & i & ",FALSE)"
    Else
        result(i,1) = data(i,1)
    End If
Next i

ActiveSheet.Cells(1,1).Resize(Ubound(result, 1), UBound(result,2)) = result