Цикл по диапазону с использованием VBA в Excel - PullRequest
Новая
       25

Цикл по диапазону с использованием VBA в Excel

1 голос
/ 15 марта 2012

У меня есть блок кода, который слишком долго обрабатывается для некоторых файлов.Меньшие файлы (меньше строк данных) работают нормально, но как только я добираюсь до 150-300, он начинает замедляться (иногда я думаю, что весь процесс фактически просто зависает), и мне иногда приходится запускать это на файлах с до6000.

Я хочу подключить функцию 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

Я просто застрял с этим?

Ответы [ 2 ]

3 голосов
/ 15 марта 2012

Большое спасибо 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
2 голосов
/ 15 марта 2012

Вы не хотите перебирать ячейки из 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
...