时间戳

首页 > 解决方案 > 你如何编写 Vlookup 代码来搜索不同的工作簿？

excel - 你如何编写 Vlookup 代码来搜索不同的工作簿？

问题描述

我无法弄清楚如何将 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

标签： excelvba

解决方案

这是我对你想要做什么的最佳猜测

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

推荐阅读