[英]Excel VBA Vlookup multiple Columns
我需要使这个宏更有效和更快。 我的解决方案非常非常慢。 可以有超过 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
我需要从两张纸中查找多列。 我只有一个标识符,我需要从另一张表中添加数据。
你能帮助我吗?
Application.Match
,您可以获得行索引(如果不匹配,则会出现错误),然后从该行( sIndex
)中读取所有必要的单元格。快速修复
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.