Как написать код Vlookup для поиска в другой книге?

Question

Я не могу понять, как ввести код vlookup в мой существующий код (ниже), который обращается к другой книге и обновляет мою основную книгу. Формула Vlookup будет выглядеть так:

= VLOOKUP (B2, '[Loading Summary.xlsx] SHIPPING'! $ A: $ K, 11, FALSE .

Я также предоставил несколько снимков экрана. В обеих книгах есть несколько соответствующих вкладок. Сложность состоит в том, что я не могу просто копировать и вставлять каждый раз, когда обновляются необработанные данные. Моя команда делает заметки о Основное расписание и не хотят, чтобы их примечания или поля менялись, они просто хотят, чтобы изменился столбец часов.

Основное расписание - Рабочая книга Исходные данные - Рабочая книга

Ошибка после попытки кода Вильямса

    Sub Import_Awea_LP2516()

       'Prevents Clipboard Pop-up from appearing.
       Application.DisplayAlerts = False
        
       'Prevents screen flicker and makes the macro run faster.
       Application.ScreenUpdating = False
       
       'Ensures the Loading Summary is open
       Workbooks.Open Filename:=Environ("USERPROFILE") & "\Dropbox (Napoleon Machine)\Operations Management\#MASTER SCHEDULE\Shop Schedule V4\Loading Summary.xlsx"

       'Copies new line items from loading summary and pastes them at the bottom of the master schedule (per machine)
       Dim ws1 As Worksheet: Set ws1 = Workbooks("Shop Schedule - Master V4.xlsm").Worksheets("Awea-LP2516")
       Dim ws2 As Worksheet: Set ws2 = Workbooks("Loading Summary.xlsx").Worksheets("LP2516")
       Dim criteria As String
       Dim found As Range
       Dim i As Long

       For i = 2 To 500
       criteria = ws1.Cells(i, 2).Value
       On Error Resume Next
       Set found = ws2.Range("A:A").Find(What:=criteria, LookAt:=xlWhole)
       On Error GoTo 0

       If found Is Nothing Then
       ws1.Cells(i, 2).EntireRow.Interior.ColorIndex = 22
       End If
        Next i

       Dim wsCopy As Worksheet
       Dim wsDest As Worksheet
       Dim lCopyLastRow As Long
       Dim lDestLastRow As Long


       Set wsCopy = Workbooks("Loading Summary.xlsx").Worksheets("LP2516")
       Set wsDest = Workbooks("Shop Schedule - Master V4.xlsm").Worksheets("Awea-LP2516")
        

       lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
        
       lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(2).Row

       wsCopy.Range("A2:O" & lCopyLastRow).Copy _
       wsDest.Range("B" & lDestLastRow)
        
       Windows("Shop Schedule - Master V4.xlsm").Activate
        
       Dim rCell As Range
       Dim rRange As Range
       Dim lCount As Long

       Set rRange = Range("B2", Range("B" & Rows.Count).End(xlUp))
       lCount = rRange.Rows.Count

       For lCount = lCount To 1 Step -1
         With rRange.Cells(lCount, 1)
            If WorksheetFunction.CountIf(rRange, .Value) > 1 Then
                .EntireRow.Delete
             End If
         End With
       Next lCount
      
      Windows("Shop Schedule - Master V4.xlsm").Activate
      Rows(2).EntireRow.Delete
      Range("A2").Select
     
      Call Master_Sheet_Cleanup
          
      Workbooks("Loading Summary.xlsx").Close SaveChanges:=False
          
      'Turns display alerts back on
      Application.DisplayAlerts = True
      Application.ScreenUpdating = True

    End Sub

Answer 1

Вот мое лучшее предположение о том, что вы хотите сделать

Sub Import_Awea_LP2516()

    Dim wbSSM As Workbook, wbLS As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Dim criteria As String
    Dim found As Range
    Dim wsCopy As Worksheet, wsDest As Worksheet
    Dim i As Long
    Dim rCell As Range
    Dim rRange As Range
    Dim res
 
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Set wbSSM = Workbooks("Shop Schedule - Master V4.xlsm") 'ThisWorkbook?
    Set wsDest = wbSSM.Worksheets("Awea-LP2516")
    
    On Error Resume Next 'in case workbook is not open
    Set wbLS = Workbooks("Loading Summary.xlsx")
    On Error GoTo 0
    If wbLS Is Nothing Then
        Set wbLS = Workbooks.Open(Filename:=Environ("USERPROFILE") & "\" & _
                 "Dropbox (Napoleon Machine)\Operations Management\#MASTER SCHEDULE\" & _
                 "Shop Schedule V4\Loading Summary.xlsx")
    End If
    Set wsCopy = wbLS.Worksheets("LP2516")
    
    'flag lines in wsDest with no ColA match on wsCopy
    For i = 2 To 500
        With wsDest.Cells(i, 2)
            'Match is faster than Find
            If IsError(Application.Match(.Value, wsCopy.Range("A:A"), 0)) Then
                .EntireRow.Interior.ColorIndex = 22
            End If
        End With
    Next i
    
    wsCopy.Range("A2:O" & wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row).Copy _
           wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(2)
    
    Set rRange = wsDest.Range("B2", wsDest.Range("B" & Rows.Count).End(xlUp))
    For i = rRange.Rows.Count To 1 Step -1
        With rRange.Cells(i, 1)
            If WorksheetFunction.CountIf(rRange, .Value) > 1 Then
                .EntireRow.Delete 'duplicate:remove
            Else
                'not removing this row - perform lookup for hours
                res = Application.VLookup(.Value, wbLS.Sheets("shipping").Range("A:K"), 11, False)
                If Not IsError(res) Then .EntireRow.Cells(11).Value = res
                'not clear what should happen if vlookup fails here?
            End If
        End With
    Next i
    
    wbLS.Close SaveChanges:=False
      
    wsDest.Rows(2).EntireRow.Delete
    wbSSM.Activate
    wsDest.Select
    wsDest.Range("A2").Select
    
    Call Master_Sheet_Cleanup
        
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub