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

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。 我从源工作簿中打开另一个工作簿目标工作簿。 我在sourcewb中的列是Sl编号，国家/地区代码，国家/地区名称

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

我的目标是

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

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

我收到错误2042。我尝试用字符串，int，long，variant存储目标值，到目前为止没有任何效果。

任何建议或帮助将非常有帮助。

Answer 1

通过对原始代码进行一些“整理”和整理，请尝试以下代码。

3条评论：

1. 使用With语句时，请不要忘记使用嵌套所有对象. 。
2. 远离使用Select和Activate ，这不仅是不必要的，而且还会减慢代码的运行时间。
3. 您需要捕获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