Question

        Dim sourcewb As Workbook
        Dim targetWorkbook As Workbook
        Dim filter As String
        Dim filter2 As String
        Dim rw As Long
        Dim lookup As String
        Dim X As Range
        Dim y As Range
        Dim a, b As Variant

       Set sourcewb = ActiveWorkbook
        Set X = sourcewb.Worksheets(1).Range("A:G")
        Dim sourceSheet As Worksheet
        Set sourceSheet = sourcewb.Worksheets(1)
        MsgBox sourceSheet.Name
        X.Select

    MsgBox sourcewb.Name

    filter = "(*.xls),*.xls"
    Caption = "Please Select an input file "
    Application.ScreenUpdating = False
    Filename = Application.GetOpenFilename(filter, , Caption)
    Set targetWorkbook = Application.Workbooks.Open(Filename)
    Set y = targetWorkbook.Worksheets(1).Range("A:G")
    y.Select

    Dim targetSheet As Worksheet
    Set targetSheet = targetWorkbook.Worksheets(1)
    MsgBox targetSheet.Name & " This is the country code sheet name "

    Set targetWorkbook = ActiveWorkbook
    MsgBox targetWorkbook.Name
    y.Select
                              sourcewb.Activate
                        MsgBox ActiveWorkbook.Name & " IS the active workbook"

                        MsgBox sourcewb.Name

                        MsgBox sourcewb.Name & " This is the source workbook "
                        MsgBox targetWorkbook.Name & " This is the target workbook "
                        MsgBox "Trying to map from target to source "



                        With sourcewb.Worksheets(1)
                        For rw= 2 To Cells(Rows.Count, 1).End(xlUp).Row

                             Cells(rw, 4) = Application.VLookup(Cells(rw, 1).Value, y, 4, False)
                             'MsgBox Cells(a, 4).Value2
                              Next rw
                        End With


                        MsgBox "All required columns from source mapped to target file "
                        Set sourcewb = ActiveWorkbook
                        MsgBox ActiveWorkbook.Name
                        Application.ScreenUpdating = False

我有一本工作簿sourcewb。我从sourceworkbook打开另一本工作簿目标工作簿。 sourcewb 中的我的列是Sl No，国家/地区代码，国家/地区名称

slno           country code      country name                Region     
  1               AL               Algeria                    
  2               US               USA                        
  3               UK               United Kingdom

我的targetwb是

         country code      country name                Region     
               AL               Algeria                   EMEA    
               US               USA                       Americas   
               UK               United Kingdom            Europe

我正在尝试从sourcewb中的国家/地区代码中获取 Region 列，因为targetwb中没有slno，并且国家/地区代码的顺序与sourcewb不同。

我收到错误2042.我尝试使用string，int，long，variant存储目标值，到目前为止还没有任何工作。

任何建议或帮助都会非常有用。

Answer 1

通过一些＆＃34;清理＆＃34;并组织原始代码，请尝试下面的代码。

3条评论：

当您使用With声明时，请勿忘记使用.将所有对象嵌套在其中。
远离使用Select和Activate，不仅没有必要，还会降低代码的运行时间。
您需要捕获Application.VLookup找不到值的方案，然后您将收到运行时错误。

代码中的解释为注释。

<强>代码

Option Explicit

Sub AutoVLookup()

Dim sourcewb As Workbook
Dim targetWorkbook As Workbook
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim X As Range
Dim y As Range

Dim filter As String
Dim filter2 As String
Dim rw As Long
Dim lookup As String
Dim a, b As Variant

Set sourcewb = ActiveWorkbook ' set Activeworkbook object
Set sourceSheet = sourcewb.Worksheets(1) ' set source sheet
Set X = sourceSheet.Range("A:G") ' set source range

filter = "(*.xls),*.xls"
Caption = "Please Select an input file "
Application.ScreenUpdating = False
Filename = Application.GetOpenFilename(filter, , Caption)

Set targetWorkbook = Workbooks.Open(Filename) ' set target workbook object
Set targetSheet = targetWorkbook.Worksheets(1) ' set target sheet
Set y = targetSheet.Range("A:G") ' set target range

With sourceSheet
    For rw = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row ' get last row in column A
        ' make sure VLoookup found a match, otherwise you will get a run-time error
        If Not IsError(Application.VLookup(.Cells(rw, 1).Value, y, 4, False)) Then
            .Cells(rw, 4) = Application.VLookup(.Cells(rw, 1).Value, y, 4, False) ' this will fetch column "E" values
            'MsgBox Cells(a, 4).Value2
        End If
    Next rw
End With

MsgBox "All required columns from source mapped to target file "

Application.ScreenUpdating = True

End Sub

VBA - Vlookup无法从文本查找值中获取

1 个答案: