[英]VBA - Vlookup not fetching from text lookup value
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
I have a workbook sourcewb. 我有一个工作簿sourcewb。 I open another workbook targetworkbook from the sourceworkbook.
我从源工作簿中打开另一个工作簿目标工作簿。 My Columns in sourcewb are Sl No, Country code,country names
我在sourcewb中的列是Sl编号,国家/地区代码,国家/地区名称
slno country code country name Region
1 AL Algeria
2 US USA
3 UK United Kingdom
My targetwb is 我的目标是
country code country name Region
AL Algeria EMEA
US USA Americas
UK United Kingdom Europe
I am trying to fetch Region column from country code in the sourcewb as there is no slno in the targetwb and the order of country codes are not the same as sourcewb. 我正在尝试从sourcewb中的国家/地区代码中提取Region列,因为targetwb中没有slno,并且国家/地区代码的顺序与sourcewb不同。
I get an error 2042. I have tried storing the target value with string, int, long, variant, nothing has worked till now. 我收到错误2042。我尝试用字符串,int,long,variant存储目标值,到目前为止没有任何效果。
Any suggestions or help would be really helpful. 任何建议或帮助将非常有帮助。
With some "clean-up" and organization to your original code, try the code below. 通过对原始代码进行一些“整理”和整理,请尝试以下代码。
3 comments: 3条评论:
With
statement, don't forget to nest all objects inside with a .
With
语句时,请不要忘记使用嵌套所有对象.
. Select
and Activate
, not only it's not necessary, it also slows down your code's run-time. Select
和Activate
,这不仅是不必要的,而且还会减慢代码的运行时间。 Application.VLookup
will not find a value, and then you will get a run-time error. Application.VLookup
找不到值的情况,然后会出现运行时错误。 Explanations inside the code as comments. 代码内部的解释为注释。
Code 码
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.