Блог

Главная - Вопросы по программированию - Есть ли более быстрый способ установить значения ячеек с помощью VBA, чем для КАЖДОГО

Есть ли более быстрый способ установить значения ячеек с помощью VBA, чем для КАЖДОГО

#excel #vba

Вопрос:

Иногда этот диапазон может составлять десятки тысяч строк для проверки. В настоящее время, чтобы установить проверку на правильное значение для выбора, я делаю a для каждого. Ниже приведена часть кода, в которой задана проверка.

 With BCS.Range("AT2:AT" amp; Lrow).Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=BStr
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With

BCS.Range("AT2:AT" amp; Lrow).Value = "1"  

ThisWorkbook.Sheets("est_temp").Range("A1:A" amp; Lrow2).Copy
ThisWorkbook.Sheets("B_C_I").Range("AO2").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.DisplayAlerts = False
ThisWorkbook.Sheets("est_temp").Delete
Application.DisplayAlerts = True

If Lrow > 2 Then
    For Each c In BCS.Range("AO2:AO" amp; Lrow)
        With c
            If c.Value = "AA" Then
                Range("AT" amp; c.Row).Value = "Std % 1"
            ElseIf c.Value = "BB" Then
                Range("AT" amp; c.Row).Value = "Std % 2"
            Else
                Range("AT" amp; c.Row).Value = "1"
            End If
        End With
    Next c
End If

По понятным причинам, когда вам нужно пройти более 25000 строк, это занимает довольно много времени. Есть ли более быстрый способ сделать это, чем для каждого?

Комментарии:

1. Используйте массивы. Загрузите данные AO в один за один раз, создайте другой такого же размера, заполните второй на основе первого, а затем запишите его обратно в AT за один раз. Вы также можете использовать EVALUATE строку формулы для ее непосредственного достижения.

2. Как выполняется/запускается код?

Ответ №1:

Как отмечает @Rory — это будет быстрее:

 Dim arr, r As Long

If Lrow > 2 Then
    arr = BCS.Range("AO2:AO" amp; Lrow).Value 'get all the data in an array
    For r = 1 to UBound(arr, 1)
        Select Case arr(r, 1)
            Case "AA": arr(r, 1) = "Std % 1"
            Case "BB": arr(r, 1) = "Std % 2"
            Case Else: arr(r, 1) = "1"
        End Select
    Next r
    BCS.Range("TO2:TO" amp; Lrow).Value = arr 'write back to sheet
End If

Комментарии:

1. Спасибо, Тим, как всегда, блестяще!

Метки: ,