VBA:VLookUp多个结果 [英] VBA: VLookUp Multiple Results
问题描述
我需要一些代码方面的帮助.
我正在尝试执行VLookup，并将数据显示在O，P和Q列中.
我想做的是循环通过sheet("Global")列A从第3行开始，直到最后使用的行.它需要匹配从第2行开始的A列的sheet("Details")中的数据.
因此，当找到匹配值时，它将显示全局" O2中详细信息" C2，全局" P2中详细信息" I2和全局" Q2中详细信息" G2的结果.
然后它需要循环遍历全局"匹配并复制所有数据.如果找不到匹配项，则显示"NA！".
我要做的最后一件事是删除全局"中未找到匹配项的所有行.
我下面的代码满足了我的需要，唯一的问题是它非常慢，要花几分钟才能遍历800行，有时甚至更长！
还有另一种方法可以运行得更流畅，更快吗?
感谢您的帮助！
谢谢
`Private Sub btnVlookUp_Click()
Dim i, j, lastG, lastD As Long
' find last row
lastG = Sheets("Global").Cells(Rows.Count, "B").End(xlUp).Row
lastD = Sheets("Details").Cells(Rows.Count, "A").End(xlUp).Row
' loop over values in "Global"
For i = 3 To lastG
lookupVal = Sheets("Global").Cells(i, "B") ' value to find
' loop over values in "details"
For j = 2 To lastD
currVal = Sheets("Details").Cells(j, "A")
If lookupVal = currVal Then
Sheets("Global").Cells(i, "O") = Sheets("Details").Cells(j, "C")
Sheets("Global").Cells(i, "P") = Sheets("Details").Cells(j, "I")
Sheets("Global").Cells(i, "Q") = Sheets("Details").Cells(j, "G")
' mark the row
Sheets("Details").Cells(j, "Z") = "marked"
End If
Next j
Next i
' loop over rows in "details" and delete rows which have not been marked
For j = 2 To lastD
If Sheets("Details").Cells(j, "Z") <> "marked" Then
' delete unmarked rows
Sheets("Details").Cells(j, "A").EntireRow.Delete
If Sheets("Details").Cells(j, "B") <> "" Then
j = j - 1 ' revert iterator so it doesn't skip rows
End If
Else:
' remove the mark
Sheets("Details").Cells(j, "Z") = ""
End If
Next j
End Sub`
有了这里的建议，以及大量的反复试验，我设法调整了代码.
我已经对600多个记录进行了测试，并且它可以在几秒钟内运行，而在以前的代码上要花几分钟.
如果您可以看到执行以下代码的更好方法，请告诉我，我仍在学习VBA，因此，我能获得的所有帮助都会变得更好！！
感谢所有支持！!!!!!!
Private Sub btnVlookUp_Click()
Dim i, j, lastG, lastD As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.CutCopyMode = False
End With
' find last row
lastG = Sheets("Global").Cells(Rows.Count, "B").End(xlUp).Row
lastD = Sheets("Details").Cells(Rows.Count, "A").End(xlUp).Row
' loop over values in "Global"
For i = 2 To lastG
lookupVal = Sheets("Global").Cells(i, "B") ' value to find
' loop over values in "details"
For j = 2 To lastD
currVal = Sheets("Details").Cells(j, "A")
If lookupVal = currVal Then
Sheets("Global").Cells(i, "O") = Sheets("Details").Cells(j, "C")
Sheets("Global").Cells(i, "P") = Sheets("Details").Cells(j, "I")
Sheets("Global").Cells(i, "Q") = Sheets("Details").Cells(j, "G")
' mark the row
Sheets("Details").Cells(j, "Z") = "marked"
Sheets("Details").Cells(1, "Z") = "marked"
Exit For
End If
Next j
Next i
On Error Resume Next
Sheets("Details").Columns("Z").SpecialCells(xlBlanks).EntireRow.Delete
Sheets("Details").Columns("Z").ClearContents
With Application
.ScreenUpdating = True
.EnableEvents = True
.CutCopyMode = True
End With
End Sub
I require a little help with some code.
I am trying to perform a VLookup, and has the data displayed in columns O, P and Q.
What i am trying to do is loop though sheet("Global") column A starting at row 3 until last used row. It needs to match data in sheet("Details") in column A starting at row 2.
So when it finds a matching value, it will display the results from "Details" C2 in "Global" O2, "Details" I2 in "Global" P2 and "Details" G2 in "Global" Q2.
It then needs to loop though "Global" matching and copying all data. If no match is found the display "NA!".
The last thing I need it to do is to delete all rows in Global where a match was not found.
The code I have below does what I need, the only problem is that it is incredibly slow, taking minutes to loop though 800 rows, sometimes even longer!!
Is there another way to do this, that will run smoother and faster?
Any help is appreciated!!
Thank You
`Private Sub btnVlookUp_Click()
Dim i, j, lastG, lastD As Long
' find last row
lastG = Sheets("Global").Cells(Rows.Count, "B").End(xlUp).Row
lastD = Sheets("Details").Cells(Rows.Count, "A").End(xlUp).Row
' loop over values in "Global"
For i = 3 To lastG
lookupVal = Sheets("Global").Cells(i, "B") ' value to find
' loop over values in "details"
For j = 2 To lastD
currVal = Sheets("Details").Cells(j, "A")
If lookupVal = currVal Then
Sheets("Global").Cells(i, "O") = Sheets("Details").Cells(j, "C")
Sheets("Global").Cells(i, "P") = Sheets("Details").Cells(j, "I")
Sheets("Global").Cells(i, "Q") = Sheets("Details").Cells(j, "G")
' mark the row
Sheets("Details").Cells(j, "Z") = "marked"
End If
Next j
Next i
' loop over rows in "details" and delete rows which have not been marked
For j = 2 To lastD
If Sheets("Details").Cells(j, "Z") <> "marked" Then
' delete unmarked rows
Sheets("Details").Cells(j, "A").EntireRow.Delete
If Sheets("Details").Cells(j, "B") <> "" Then
j = j - 1 ' revert iterator so it doesn't skip rows
End If
Else:
' remove the mark
Sheets("Details").Cells(j, "Z") = ""
End If
Next j
End Sub`
With the advice on here, and a lot of trial and error, i have managed to tweak my code.
I tested this on over 600 records and it runs in seconds, where it would have taken minutes on the previous code.
If you can see a better way of doing the below code, then let me know, i'm still learning VBA so all the help I can get the better!!!
Thanks for all the support!!!!!!!!
Private Sub btnVlookUp_Click()
Dim i, j, lastG, lastD As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.CutCopyMode = False
End With
' find last row
lastG = Sheets("Global").Cells(Rows.Count, "B").End(xlUp).Row
lastD = Sheets("Details").Cells(Rows.Count, "A").End(xlUp).Row
' loop over values in "Global"
For i = 2 To lastG
lookupVal = Sheets("Global").Cells(i, "B") ' value to find
' loop over values in "details"
For j = 2 To lastD
currVal = Sheets("Details").Cells(j, "A")
If lookupVal = currVal Then
Sheets("Global").Cells(i, "O") = Sheets("Details").Cells(j, "C")
Sheets("Global").Cells(i, "P") = Sheets("Details").Cells(j, "I")
Sheets("Global").Cells(i, "Q") = Sheets("Details").Cells(j, "G")
' mark the row
Sheets("Details").Cells(j, "Z") = "marked"
Sheets("Details").Cells(1, "Z") = "marked"
Exit For
End If
Next j
Next i
On Error Resume Next
Sheets("Details").Columns("Z").SpecialCells(xlBlanks).EntireRow.Delete
Sheets("Details").Columns("Z").ClearContents
With Application
.ScreenUpdating = True
.EnableEvents = True
.CutCopyMode = True
End With
End Sub
这篇关于VBA:VLookUp多个结果的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
