简体   繁体   English

跨多个工作表的VBA Vlookup

[英]VBA Vlookup across multiple sheets

So I have two lists, each one in a different sheet. 因此,我有两个列表,每个列表在不同的工作表中。 I'm checking that values in Sheet B are also in Sheet A. I'm using VLookup for this, the problem seems to be with the range statements, as this range appears to be 'empty'. 我正在检查工作表B中的值是否也在工作表A中。为此,我使用VLookup,问题似乎出在range语句上,因为此范围似乎是“空”的。

My VBA attempt is something like, 我的VBA尝试是这样的,

Dim lookupVal As String
Dim myString As String

For i = 1 to N
    lookupVal = Sheets("b").Cells(1 + i, 2)
    myString = Application.WorksheetFunction.VLookup(lookupVal, Sheets("a").range(Sheets("a").Cells(9,3), Sheets("a").Cells(N+8, 3)), 1, False)
    If IsEmpty(myString) Then
        Sheets("b").Cells(1+i, 3) = ""
    Else
        Sheets("b").Cells(1+i, 3) = myString
    End if

Next i

I get 'Run-time 1004: Application-defined or object-defined error'. 我收到“运行时1004:应用程序定义或对象定义的错误”。 Any help appreciated. 任何帮助表示赞赏。

Change your code to the below. 将您的代码更改为以下内容。

If IsEmpty(myString) is the wrong way to do it. If IsEmpty(myString)是错误的方法。 In case of #N/A , that statement will still be true. #N/A情况下,该语句仍然是正确的。

Is this what you are trying? 这是您要尝试的吗?

Sub Sample()
    Dim lookupVal As String
    Dim myString As Variant
    Dim rng As Range

    '~~> Change this whatever you want
    n = 5

    For i = 1 To n
        lookupVal = Sheets("b").Cells(1 + i, 2)

        Set rng = Sheets("a").Range(Sheets("a").Cells(9, 3), Sheets("a").Cells(n + 8, 3))

        myString = Application.Evaluate("=VLOOKUP(" & lookupVal & "," & "a!" & rng.Address & ",1,0)")

        Select Case CVErr(myString)
            Case CVErr(xlErrName), CVErr(xlErrNA), CVErr(xlErrRef), CVErr(xlErrValue)
            Case Else: Sheets("b").Cells(1 + i, 3) = myString
        End Select
    Next i
End Sub

There are two problems in your code: 您的代码中有两个问题:

  1. for worksheetfunction.vlookup the searching range cant be volatile. 对于worksheetfunction.vlookup ,搜索范围不能是可变的。 So the way to solve this issue is to use additional variable to do it permanent 因此,解决此问题的方法是使用其他变量将其永久化

  2. if worksheetfunction.vlookup cannot find the searching value, then error will appear, in this case you need to use additional manipulation with error handling 如果worksheetfunction.vlookup找不到搜索值,则会出现错误,在这种情况下,您需要对错误处理使用其他操作

  3. lookupVal must be declared as Range due to format of the cells (lookup range and lookup value) can be different, but in your code cells value always will be converted into string type, and you will not be able to find numbers if they converted into string 由于单元格的格式(lookup范围和lookup值)可以不同, lookupVal必须将lookupVal声明as Range ,但是在代码单元格中,值始终会转换为字符串类型,如果将其转换为字符串类型,则将无法找到数字串

  4. myString also required to be declared as Variant due to same reason as described in "3." 由于与“ 3”中所述的相同原因,还必须将myString声明as Variant Type of the cell can be double for instance, but your code will convert it into string 例如,单元格的类型可以为double ,但是您的代码会将其转换为string

so, your updated code is below, works fine 因此,您的更新代码如下,可以正常工作

Sub test()
Dim lookupVal As Range, myString As Variant, Rng$, n&
n = Sheets("b").[B:B].Cells.Find("*", , , , xlByRows, xlPrevious).Row
On Error Resume Next
For i = 1 To n
    Set lookupVal = Sheets("b").Cells(1 + i, 2)
    Rng = Range(Cells(9, 3), Cells(n + 8, 3)).Address
    myString = WorksheetFunction.VLookup(lookupVal, Sheets("a").Range(Rng), 1, False)
    If Err.Number > 0 Then
        Sheets("b").Cells(1 + i, 3) = ""
        Err.Clear
    Else
        Sheets("b").Cells(1 + i, 3) = myString
    End If
Next i
End Sub

alternative way below 下面的替代方法

Sub test()
Dim cl As Range, Dic As Object
Set Dic = CreateObject("Scripting.Dictionary"): Dic.Comparemode = vbTextCompare
With Sheets("a")
    For Each cl In .Range("C9:C" & .Cells(Rows.Count, "C").End(xlUp).Row)
        If Not Dic.exists(cl.Value) Then Dic.Add cl.Value, cl.Row
    Next cl
End With
With Sheets("b")
    For Each cl In .Range("B2:B" & .Cells(Rows.Count, "B").End(xlUp).Row)
        If Dic.exists(cl.Value) Then cl.Offset(, 1).Value = cl.Value
    Next cl
End With
Set Dic = Nothing
End Sub

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM