[英]Excel VBA Vlookup multiple Columns
i need make this macro more effective and faster.我需要使这个宏更有效和更快。 My solution is very, very slow.我的解决方案非常非常慢。 There can be over 100k rows可以有超过 100k 行
Sub VlookupPOR()
Dim PorWs As Worksheet, InDataBodyWs As Worksheet
Dim PorLastRow As Long, InDataBodyLastRow As Long, x As Long
Dim dataRng As Range
Set PorWs = ThisWorkbook.Worksheets("POR")
Set InDataBodyWs = ThisWorkbook.Worksheets("InDataBody")
PorLastRow = PorWs.Range("A" & Rows.Count).End(xlUp).Row
InDataBodyLastRow = InDataBodyWs.Range("H" & Rows.Count).End(xlUp).Row
Set dataRng = InDataBodyWs.Range("H4:AR" & InDataBodyLastRow)
For x = 2 To PorLastRow
On Error Resume Next
PorWs.Range("L" & x).Value = Application.WorksheetFunction.VLookup( _
PorWs.Range("G" & x).Value, dataRng, 5, False) 'LastName
PorWs.Range("N" & x).Value = Application.WorksheetFunction.VLookup( _
PorWs.Range("G" & x).Value, dataRng, 7, False) 'FirstName
PorWs.Range("O" & x).Value = Application.WorksheetFunction.VLookup( _
PorWs.Range("G" & x).Value, dataRng, 2, False) 'BirthNumber
PorWs.Range("K" & x).Value = Application.WorksheetFunction.VLookup( _
PorWs.Range("G" & x).Value, dataRng, 4, False) 'NativeLastName
PorWs.Range("J" & x).Value = Application.WorksheetFunction.VLookup( _
PorWs.Range("G" & x).Value, dataRng, 16, False) 'legalPersonName
PorWs.Range("H" & x).Value = Application.WorksheetFunction.VLookup( _
PorWs.Range("G" & x).Value, dataRng, 18, False) 'legalPersonBusinessId
PorWs.Range("I" & x).Value = Application.WorksheetFunction.VLookup( _
PorWs.Range("G" & x).Value, dataRng, 24, False) 'legalPersonBusinessId
Next x
End Sub
I need a vlookup for multiple columns from two sheets.我需要从两张纸中查找多列。 I have only one identifier for everything and I need to add data from another sheet.我只有一个标识符,我需要从另一张表中添加数据。
Can you help me?你能帮助我吗?
Application.Match
you get the row index (or an error if no match) and then read all the necessary cells from this row ( sIndex
).使用Application.Match
,您可以获得行索引(如果不匹配,则会出现错误),然后从该行( sIndex
)中读取所有必要的单元格。A Quick Fix快速修复
Sub LookupPOR()
' Source
Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets("InDataBody")
Dim slRow As Long: slRow = sws.Range("H" & sws.Rows.Count).End(xlUp).Row
Dim srg As Range: Set srg = sws.Range("H4:AR" & slRow)
Dim scrg As Range: Set scrg = srg.Columns(1)
' Destination
Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets("POR")
Dim dlRow As Long: dlRow = dws.Range("A" & dws.Rows.Count).End(xlUp).Row
Dim dValue As Variant
Dim sIndex As Variant
Dim r As Long
For r = 2 To dlRow
dValue = dws.Cells(r, "G").Value
If Not IsError(dValue) Then
If Len(dValue) > 0 Then
sIndex = Application.Match(dValue, scrg, 0)
If IsNumeric(sIndex) Then
' legalPersonBusinessId - "Y"
dws.Cells(r, "H").Value = srg.Cells(sIndex, 18).Value
' legalPersonBusinessId - "AE"
dws.Cells(r, "I").Value = srg.Cells(sIndex, 24).Value
' legalPersonName - "W"
dws.Cells(r, "J").Value = srg.Cells(sIndex, 16).Value
' NativeLastName - "K"
dws.Cells(r, "K").Value = srg.Cells(sIndex, 4).Value
' LastName - "L"
dws.Cells(r, "L").Value = srg.Cells(sIndex, 5).Value
' FirstName - "N"
dws.Cells(r, "N").Value = srg.Cells(sIndex, 7).Value
' BirthNumber - "I"
dws.Cells(r, "O").Value = srg.Cells(sIndex, 2).Value
End If
End If
End If
Next r
MsgBox "Lookup complete.", vbInformation
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.