在Excel中使用VBA遍历范围

Question

我有一段代码，对于某些文件来说处理时间太长。 较小的文件（较少的数据行）可以正常工作，但是一旦达到150-300左右，它就会开始变慢，（有时我认为整个过程实际上都挂起了），有时我必须在最大六千

我想在.FormulaR1C1为多个VLookup()插入VLookup()函数。 我知道我可以使用.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

我只是坚持吗？

Answer 1

非常感谢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

Answer 2

你不想遍历从VBA细胞：这是非常缓慢的。 相反，您将所需的数据放入数组中，在该数组上工作，然后将数据放回到工作表中。 就您而言，类似于以下代码（未经测试）：

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