Excel VBA, проблема с диапазоном массива

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

Option Explicit

Public Sub Button2_Click()
    Application.ScreenUpdating = False
    
    Dim mainSheet As Worksheet: Set mainSheet = ThisWorkbook.Sheets("Main")
    mainSheet.Range("B11:F" & mainSheet.Cells(mainSheet.Rows.Count, "B").End(xlDown).Row).ClearContents
    mainSheet.Range("I11:O" & mainSheet.Cells(mainSheet.Rows.Count, "I").End(xlDown).Row).ClearContents
    Dim partNum As String: partNum = mainSheet.Range("B5").Value
    If partNum = "" Then
        MsgBox "Please enter a part number.", vbExclamation
        Exit Sub
    End If
    
    SearchShortage mainSheet, partNum
    
    SearchPpn mainSheet, partNum
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Search complete!", vbInformation
End Sub

Public Sub SearchShortage(mainSheet As Worksheet, partNum As String)
    Dim shortageSheet As Worksheet: Set shortageSheet = ThisWorkbook.Sheets("SHORTAGE")
    Dim shortageLastRow As Long: shortageLastRow = shortageSheet.Cells(shortageSheet.Rows.Count, "B").End(xlUp).Row
    Dim shortageData As Variant: shortageData = shortageSheet.Range("B1:F" & shortageLastRow).Value
    Dim recordFound As Boolean: recordFound = False
    Dim i As Long: For i = 1 To shortageLastRow
        If shortageData(i, 1).Value = partNum Then
            Dim mainLastRow As Long: mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "B").End(xlUp).Row + 1
            mainSheet.Range("B" & mainLastRow & ":I" & mainLastRow).Value = _
                WorksheetFunction.Index(shortageData, i, Array(1, 2, 3, 4, 5))
            recordFound = True
        End If
    Next i
    If Not recordFound Then
        MsgBox "No records found in SHORTAGE"
    End If
End Sub

Public Sub SearchPpn(mainSheet As Worksheet, partNum As String)
    Dim ppnSheet As Worksheet: Set ppnSheet = ThisWorkbook.Sheets("PPN")
    Dim ppnLastRow As Long: ppnLastRow = ppnSheet.Cells(ppnSheet.Rows.Count, "G").End(xlUp).Row
    Dim ppnData As Variant: ppnData = ppnSheet.Range("G1:N" & ppnLastRow).Value
    Dim recordFound As Boolean: recordFound = False
    Dim i As Long: For i = 1 To ppnLastRow
        If ppnData(i, 1).Value = partNum Then
            Dim mainLastRow As Long: mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "I").End(xlUp).Row + 1
            mainSheet.Range("I" & mainLastRow & ":O" & mainLastRow).Value = _
                WorksheetFunction.Index(ppnData, i, Array(1, 2, 3, 4, 5, 6, 7, 8))
            recordFound = True
        End If
    Next i
    If Not recordFound Then
        MsgBox "No records found in PPN"
    End If
End Sub

Затем я бы продолжил поиск сходства между SearchShortage и SearchPpn и создал более абстрактную функцию, которая вызывается с другими параметрами. Однако, поскольку у меня нет вашей рабочей книги, я не могу протестировать какие-либо модификации. И я вижу некоторые несоответствия, которые могут вызвать ошибку (например, диапазон B:I mainSheet (8 столбцов) перезаписывается 5 значениями, а его диапазон I:O (7 столбцов) перезаписывается 8 значениями). Так что я пропущу эту часть.

Далее, я хотел бы точно понять вашу проблему. Основываясь на том, что вы написали, я думаю, вы хотели бы добавить функцию, назовем ее SearchPrompt, которая имеет аналогичную задачу, например:

Public Sub Searchprompt(mainSheet As Worksheet, partNum As String)
    Dim promptSheet As Worksheet: Set promptSheet = ThisWorkbook.Sheets("PROMPT")
    Dim promptLastRow As Long: promptLastRow = promptSheet.Cells(promptSheet.Rows.Count, "B").End(xlUp).Row
    Dim promptData As Variant: promptData = Union(promptSheet.Range("A1:F" & promptLastRow), promptSheet.Range("L1:L" & promptLastRow), promptSheet.Range("N1:N" & promptLastRow)).Value,
    Dim recordFound As Boolean: recordFound = False
    Dim i As Long: For i = 1 To promptLastRow
        If promptData(i, 1).Value = partNum Then
            Dim mainLastRow As Long: mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "S").End(xlUp).Row + 1
            mainSheet.Range("S" & mainLastRow & ":Z" & mainLastRow).Value = _
                WorksheetFunction.Index(promptData, i, Array(1, 2, 3, 4, 5, 6, 7, 8))
            recordFound = True
        End If
    Next i
    If Not recordFound Then
        MsgBox "No records found in prompt"
    End If
End Sub

И проблема в том, что первые шесть ячеек (в приведенном выше примере, S:X, как я догадался, что B:F — это дефицит, затем 2 пустых столбца, I:P для PPN, затем 2 пустых столбца и, наконец, S: Z для подсказки) заполнены правильными значениями, а последние два (Y: Z) заполнены #REF!.

Вы уже правильно заметили, что это может быть вызвано несмежным диапазоном. Я предполагаю, что это так, Union создает объект Range, который имеет несколько «поддиапазонов» в своем свойстве .Areas, и если вы ссылаетесь на его .Value, то он интерпретируется как .Areas(1).Value, а остальное (например, .Areas(2) игнорируется).

Теперь есть два решения:

(1) Повторите эти .Areas в вашем коде - это немного сложнее, чем другое решение, и я недостаточно знаю ваш рабочий лист, чтобы сделать хорошее предположение об этом.

(2) Просто используйте непрерывный диапазон. Вы можете искать в диапазоне A:N, а затем позже (при представлении результатов) опустить ненужные вам ячейки. Вы можете сделать это, настроив числа в массиве, указанном в качестве третьего параметра Application.Index (точнее, WorksheetFunction.Index), например так:

Public Sub Searchprompt(mainSheet As Worksheet, partNum As String)
    Dim promptSheet As Worksheet: Set promptSheet = ThisWorkbook.Sheets("PROMPT")
    Dim promptLastRow As Long: promptLastRow = promptSheet.Cells(promptSheet.Rows.Count, "B").End(xlUp).Row
    Dim promptData As Variant: promptData = promptSheet.Range("A1:N" & promptLastRow).Value
    Dim recordFound As Boolean: recordFound = False
    Dim i As Long: For i = 1 To promptLastRow
        If promptData(i, 1).Value = partNum Then
            Dim mainLastRow As Long: mainLastRow = mainSheet.Cells(mainSheet.Rows.Count, "S").End(xlUp).Row + 1
            mainSheet.Range("S" & mainLastRow & ":X" & mainLastRow).Value = _
                WorksheetFunction.Index(promptData, i, Array(1, 2, 3, 4, 5, 6, 12, 14))
            recordFound = True
        End If
    Next i
    If Not recordFound Then
        MsgBox "No records found in prompt"
    End If
End Sub

Обратите внимание, что WorksheetFunction.Index вызывается с помощью Array(1, 2, 3, 4, 5, 6, 12, 14): 1 .. 6 относятся к A .. F, 12 к L и 14 к N.