Как заполнить столбец, используя двумерный массив для поиска (VBA)

Question

У меня есть столбец в электронной таблице, который имеет некоторые значения. Я создал массив, распределяющий эти значения по группе. Я хочу заполнить 2-й столбец, используя поиск от массива до последней строки.

Текущий вид:

column A
A
B
C
A 
...

Целевой вид:

column A    column B
A            1
B            2
C            3
A            1
...

Это то, что я имею до сих пор:

Dim Array as Variant
Dim lr as long
numlookup=(Array("A", 1), Array("B",2), Array("C",3))

lr = Cells(Rows.Count, 1).End(xlUp).Row

Range("A2:A" & lr).Formula = "=IF(application.match(ActiveCell.Value, numlookup,0)".cell(numlookup,1).value

Спасибо!

Answer 1

Я рекомендую разделять код и данные (жесткое кодирование данных - очень плохая практика). Поэтому плохая идея жестко кодировать группировку в массиве Arr=(Array("A", 1), Array("B",2), Array("C",3)). Вместо этого вы хотели бы сохранить эти данные в (возможно, скрытом) листе.

Так что ваш GroupLookup лист будет выглядеть так

column A    column B
A            1
B            2
C            3

Тогда вы можете использовать простую функцию VLOOKUP в вашем листе данных

column A   column B
A          =VLOOKUP(A:A,GroupLookup!A:B,2,FALSE)
B
C
A 
...

---

Редактировать из-за комментария:

Если вам нужно сделать это с VBA, все равно поместите ваш GroupLookup в лист, а не в код! Например, в вашей надстройке или в том месте, куда вы добавили макрос, но на следующем листе:

Так что ваш GroupLookup лист будет выглядеть так

column A    column B
A            1
B            2
C            3

И найдите группы на этом листе с помощью метода WorksheetFunction.VLookup

Option Explicit 

Sub WriteGroups()
    Dim GroupLookup As Worksheet 'define workbook/sheet where the group lookup table is
    Set GroupLookup = ThisWorkbook.Worksheets("GroupLookup")


    With Workbooks("YourWb").ActiveSheet 'this is the sheet where the group is written to
        Dim LastRow As Long
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        Dim iRow As Long
        For iRow = 1 To LastRow
            On Error Resume Next
            .Cells(iRow, "B").Value = Application.WorksheetFunction.Vlookup(.Cells(iRow, "A").Value, GroupLookup.Range("A:B"), 2, False)
            If Err.Number <> 0 Then .Cells(iRow, "B").Value = CVErr(xlErrNA) 'write #NA if group not found
            On Error Goto 0
        Next iRow
    End With

End Sub