VBA:VLookUp多重结果

时间:2015-08-04 19:22:20

标签: vba excel-vba excel-2010 excel

我需要一些代码的帮助。

我正在尝试执行VLookup,并且数据显示在O,P和Q列中。

我想要做的是循环通过工作表(“全局”)列A从第3行开始直到最后使用的行。它需要匹配从第2行开始的A列表中的数据(“详细信息”)。

因此,当找到匹配值时,它将显示“全局”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`

3 个答案:

答案 0 :(得分:2)

根据这里的建议以及大量的反复试验,我设法调整了我的代码。

我在超过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

答案 1 :(得分:1)

您编写的代码效率非常低,这就是为什么它需要永远。你没有特别提到你的&#34; Global&#34;和&#34;细节&#34;床单(你提到800,不确定这两者是否都是)。但如果每个都有1000个,那么你的两个循环是1000x1000 = 100万个循环。

最好的解决方案是根本不使用VBA,而是在Excel中使用VLOOKUP功能。以下是您需要做的事情:

按列A对详细信息表进行排序 然后,在全局工作表中,在单元格O3中,您将使用以下公式: = VLOOKUP(A3,详情!$ A2:$ I(无论最后一行是什么),3,FALSE)

如果您不熟悉此函数,它会获取第一个参数,在第二个参数的第一列中查找它,直到找到匹配项,然后在列中返回该行中的值第三个论点。最后一次&#34; FALSE&#34;只给你一个完全匹配,否则你会得到一个#NA(如果你使用TRUE,你将获得最接近的匹配)。

然后将此公式复制到整张表格中。

然后复制列,并粘贴值。这摆脱了论坛,只留下了价值观,这使得一切都变得更快。

然后按此列对表进行排序,所有#NA都会合在一起,您可以在一次操作中删除整个内容。

如果您想通过VBA执行此操作,可以轻松编码上述步骤:

Private Sub btnVlookUp_Click()
Dim i, j, lastG, lastD As Long
Dim DetailsTable as Range

' find last row
lastG = Sheets("Global").Cells(Rows.Count, "B").End(xlUp).Row
lastD = Sheets("Details").Cells(Rows.Count, "A").End(xlUp).Row

' Make sure this is sorted.  If not, you'll need to add a sort command
Set DetailsTable=Sheets("Details").Range(Sheets("Details").Cells(1, 2), Sheets.Cells(lastD, 9))

Sheets("Global").Range("O3")="=VLOOKUP(A3," & DetailsTable.address(external:=true) & "3,FALSE)"
Sheets("Global").Range("O3").copy destination:=Sheets("Global").Range( Sheets("Global").cells(3,"O"),Sheets("Global").cells(lastG,"O"))

End Sub

这是一个开始,但应该让你去。祝你好运!

答案 2 :(得分:0)

您可以采取一些措施来轻松加快代码速度。

首先,如果您在代码的开头添加行Application.ScreenUpdating = False,它将阻止Excel执行您在执行代码时看到的所有闪烁和闪烁(实际上是在添加那些值一个接一个,删除行等等都需要花费很多时间)。

接下来,您可以在Exit For声明的最后(If之前)添加End If。这将停止嵌套的For循环,以防止在您找到所需内容后运行所有数据。

最后,我知道您使用j = j - 1将迭代器设置为不跳过行,但更好的做法是改为反向运行。如果您将For循环更改为For j = lastD to 2 Step -1,它将使循环反向运行,因此删除的行不是问题,您可以删除“重置”行(这只会勉强加速您的代码,它是更多关于如何处理这个常见问题的建议。)