Заполнить столбец значениями, зависящими от значений двух других столбцов

Question

Есть макрос, рассматривающий значение в двух ячейках (находящихся в одной строке), и, в зависимости от этих значений, присваивает значение третьей.

Dim p As Range
Dim r As Range
Set g = Range("CX2")
Set p = Range("BH2")
Set r = Range("CY2")
Select Case g
Case Is = 0
If p < 300 Then
r = 1
ElseIf p >= 300 And p <= 500 Then
r = 2
ElseIf p > 500 And p <= 800 Then
r = 3
ElseIf p > 800 And p <= 1200 Then
r = 4
Else
r = 5
End If
Case Is = 1
И так далее, рассматривая разные случаи значения g

Вопрос: как модернизировать код, чтоб он работал для массива ячеек? То есть он повторял бы эту процедуру для 100 ячеек, поочередно "спускаясь" вниз? Просто "растянуть" его как формулу нельзя. Можно ли как-то улучшить код?

Answer 1

Работаем с массивами - так быстрее, чем обращаться каждый раз к листу.

Sub yyy()
    Dim aQ(), aP(), aR()
    Dim i As Long
    Const lRw As Long = 100

    aQ = Range("CX2:CX" & lRw).Value
    aP = Range("BH2:BH" & lRw).Value
    ReDim aR(1 To lRw, 1 To 1)

    For i = 1 To lRw - 1
        Select Case aQ(i, 1)
        Case 0
            Select Case aP(i, 1)
            Case Is < 300: aR(i, 1) = 1
            Case Is <= 500: aR(i, 1) = 2
            Case Is <= 800: aR(i, 1) = 3
            Case Is <= 1200: aR(i, 1) = 4
            Case Else: aR(i, 1) = 5
            End Select
        Case 1
        '.......................'
        End Select
    Next i

    Range("CY2:CY" & lRw).Value = aR
End Sub

БЛОГ НА HUSL

Заполнить столбец значениями, зависящими от значений двух других столбцов

Ответы (1 шт):