Question

我有一段代码，需要花费太长时间来处理某些文件。较小的文件（较少的数据行）工作正常，但是一旦我达到150-300左右，它开始变慢，（有时我认为整个过程实际上只是挂起）而且我有时必须在最多的文件上运行6000。

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

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

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

2 个答案: