VBA – Vlookup不从文本查找值中提取

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.我试图存储目标值与string，诠释，长，变种，一直到现在没有工作。

任何build议或帮助将是非常有帮助的。

Answer 1

随着一些“清理”和组织到您的原始代码，请尝试下面的代码。

3评论：

1. 当你使用With语句时，不要忘记用a来嵌套所有的对象. 。
2. 远离使用Select和Activate ，不仅没有必要，而且还会减慢代码的运行时间。
3. 您需要捕获Application.VLookup无法find值的场景，然后您将收到运行时错误。

代码内的解释为注释。

码

 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