INDEX MATCH для нескольких столбцов для большого набора данных

Question

Я настраиваю некоторую автоматизацию для объединения двух баз данных в Excel.Каждая строка имеет уникальный идентификатор (столбец C).Я написал некоторый код, который работает, но он неуклюжий и уродливый и не может быть адаптирован к гораздо более серьезным проблемам.

В настоящее время код циклически перебирает строки в таблицах назначения и соответствует, где он находит результат.Если результата нет, он использует пакет ошибок для перехода к следующему столбцу.Это работает, но я хотел бы иметь возможность перемещать множество столбцов вокруг, и добавление еще одной строки повтора и обработчика ошибок для каждого столбца не годится.

Буду признателен за любые советы, чтобы уподобить код в цикле DO While.

Public Sub HistoryTransfer()

    Application.ScreenUpdating = False

    'copies last month's history information into this months RAG spreadsheet
    Dim HistoryWS As Worksheet
    Set HistoryWS = ActiveWorkbook.Sheets("RAG History")

    Dim RAGspreadsheet As Worksheet
    Set RAGspreadsheet = ActiveWorkbook.Sheets("RAG Spreadsheet")

    Dim lastRow As Integer
    lastRow = HistoryWS.Cells(Rows.Count, "A").End(xlUp).Row

    Dim RAGlastRow As Integer
    RAGlastRow = RAGspreadsheet.Cells(Rows.Count, "A").End(xlUp).Row

    Dim i As Integer
    i = 11
    Do While i < RAGlastRow
        On Error GoTo Errorhandler
        RAGspreadsheet.Range("Z" & i) = WorksheetFunction.Index(HistoryWS.Range("N11", "N" & lastRow), Application.Match(RAGspreadsheet.Range("C" & i).Value, HistoryWS.Range("C11", "C" & lastRow), 0))
Errorskip:
        On Error GoTo Errorhandler2
        RAGspreadsheet.Range("AA" & i) = WorksheetFunction.Index(HistoryWS.Range("O11", "O" & lastRow), Application.Match(RAGspreadsheet.Range("C" & i).Value, HistoryWS.Range("C11", "C" & lastRow), 0))
Errorskip2:
        On Error GoTo Errorhandler3
        RAGspreadsheet.Range("AB" & i) = WorksheetFunction.Index(HistoryWS.Range("P11", "P" & lastRow), Application.Match(RAGspreadsheet.Range("C" & i).Value, HistoryWS.Range("C11", "C" & lastRow), 0))
Errorskip3:
        i = i + 1
    Loop

Exit Sub

Errorhandler:
    Resume Errorskip:

Errorhandler2:
    Resume Errorskip2:

Errorhandler3:
    Resume Errorskip3:

    Application.ScreenUpdating = True

End Sub

Answer 1

Пример использования find, описанный в комментарии к посту (не проверено):

arr = array("26", "27", "28") 'Z, AA, AB
For i = 11 to RAGlastrow
    Set rng = HistoryWS.Columns(3).Find(RAGspreadsheet.Cells(i,3).Value, lookin:=xlValues)
    If NOT rng = Nothing then
        For j = lbound(arr) to ubound(arr)
            RAGspreadsheet.Cells(i,arr(j)) = HistoryWS.Cells(rng.Row,arr(j)-12)
        Next j
    End If
Next i

---

Также будет переформулировать первое предложение комментария:

Replace `WorkSheetFunction.` with `Application.` to trap the error.

Это происходит из-за поведения каждого.WorksheetFunction обрабатывает ошибку как ошибку и останавливает код, переходя в режим отладки.Для Application. VBA назначит ошибку в качестве переменной и перейдет к следующей.

---

Edit1: Кружка Мэта на днях лучше объяснила разницу дляWorkSheetFunction против Application в https://stackoverflow.com/a/56383812/1188513 (скопирована ссылка из его комментария)