Блог

Я пытаюсь создать инструмент, в котором я могу выбрать 2 файла. В первом файле (файл 1 в диапазоне B2) вносятся некоторые изменения, прежде чем искать значения во втором файле (файл 2 в диапазоне B3) и вставлять их в первый файл. Я создал две кнопки в инструменте для выбора файлов.

Я хочу написать код для поиска значений во втором файле, но я получаю разные ошибки при извлечении информации из второго второго файла. Кто-нибудь может мне в этом помочь?

Мне нужно вставить значения в 8-й строке из второго файла в первый файл (тот же столбец), используя значение поиска из первого столбца.

Смотрите код ниже: это то, что я пробовал. Отладка необходима в подразделе vlookup. Кто-нибудь может мне в этом помочь? Есть ли более простой способ поиска значений?

 Sub Past_dues_button12345()
'Macro to create past due list daily
Dim wb1 As Excel.Workbook
Dim File As String
Dim File2 As String

File = Sheets("Tool").Range("B2")
File2 = Sheets("Tool").Range("B3")

Set wb1 = Workbooks.Open(File)

remove_repair
add_columns_with_comments
add_data_new_column
vlookup
pastevalues
Sharewb

End Sub


Sub add_columns_with_comments()

    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Table1[[#Headers],[Column3]]").Select
    ActiveCell.FormulaR1C1 = "PN"
    Range("Table1[[#Headers],[Column2]]").Select
    ActiveCell.FormulaR1C1 = "MRPc"
    Range("Table1[[#Headers],[Column1]]").Select
    ActiveCell.FormulaR1C1 = "Comment"
    
End Sub

Sub vlookup()

    Dim rw As Long, x As Range
    Dim extwbk As Workbook, twb As Workbook

    Set twb = ThisWorkbook
    
    Workbooks("Tool_SO.XLSM").Activate
    File2 = Sheets("Tool").Range("B3")
    
    Set extwbk = Workbooks.Open(File2)
    
    Set x = extwbk.Worksheets("Material Availability").Range("A1:H1000")

    With twb.Sheets("Material Availability")

        For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            .Cells(rw, 2) = Application.vlookup(.Cells(rw, 1).Value2, x, 8, False)
        Next rw

    End With

    extwbk.Close savechanges:=False
    
End Sub
 

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

Таким образом, массивы будут вашим другом.

Вот очень простая модель, которую я построил, в Book1 :

Основываясь на указанной модели, я надеюсь Match сделать это с помощью столбца 1 и Index столбца 2 в Book2 ( ThisWorkbook ).

Будет несколько элементов для измерения, включая конечные строки/столбцы, приведенный выше массив, входные термины, выходные ячейки… но хорошая настройка несет в себе вес.

Я настрою это в одной подпрограмме для одного поискового запроса и выходной ячейки, отметив, что InputBoxes для имен книг, функций и т. Д. Это сделает это более надежным… цель моего поста-привести пример.

Вот код, который я бы сгенерировал для сопоставления в приведенном выше массиве ( searchArray в моем коде), используя одну ячейку для ввода/вывода:

 Sub IndexFromExternalSearchSheetViaArray()
    'Using External Workbook
    Dim searchSheet As Worksheet
    Set searchSheet = Workbooks("Book1").Worksheets(1)
    With searchSheet
        Dim searchSheetEndColumn As Long
        searchSheetEndColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Dim searchSheetEndRow As Long
        searchSheetEndRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Dim searchArray As Variant
        searchArray = .Range(.Cells(1, 1), .Cells(searchSheetEndRow, searchSheetEndColumn)).Value
    End With
    'Using This Workbook
    Dim outputSheet As Worksheet
    Set outputSheet = ThisWorkbook.Worksheets(1)
    Dim searchTerm As Range
    Set searchTerm = outputSheet.Cells(1, 1)
    Dim outputCell As Range
    Set outputCell = outputSheet.Cells(1, 2)
    'Matching/Indexing with Array
    Dim iterator As Long
    For iterator = 1 To searchSheetEndRow Step 1
        If searchTerm.Value = searchArray(iterator, 1) Then
            Dim outputValue As String
            outputValue = searchArray(iterator, 2)
            Exit For
        Else
            If iterator = searchSheetEndRow Then outputValue = "No match found"
        End If
    Next iterator
    'Final Output
    outputCell.Value = outputValue
End Sub
 

С помощью одного ввода, после запуска кода, я, возможно,:

или: