搜索两列并从第三个VBA返回值

时间:2010-01-28 16:31:00

标签: excel vba excel-vba

我的一位同事有一个由3列组成的excel电子表格,并希望更容易搜索。

他所拥有的是两个单元格,它从一列输入一个值,从第二列输入一个值。他想要做的是在电子表格中搜索值1和2分别存在于第一列和第二列的同一行中的实例,然后返回位于同一行的第三列中的值。

例如,我有一个如下所示的表格,所以如果他将B和2输入到单元格中,则BP返回到第三个单元格。

A 1 AP

B 2 BP

C 3 CP

谢谢

3 个答案:

答案 0 :(得分:3)

让我们在新的Excel模块中创建以下功能:

Function FindValue(rng1 As Range, rng2 As Range) As Variant
Dim varVal1 As Variant
Dim varVal2 As Variant
Dim rngTargetA As Range
Dim rngTargetB As Range
Dim lngRowCounter As Long
Dim ws As Worksheet

varVal1 = rng1.Value
varVal2 = rng2.Value

Set ws = ActiveSheet
lngRowCounter = 2
Set rngTargetA = ws.Range("A" & lngRowCounter)
Set rngTargetB = ws.Range("B" & lngRowCounter)
Do While Not IsEmpty(rngTargetA.Value)
    If rngTargetA.Value = varVal1 And rngTargetB.Value = varVal2 Then
        FindValue = ws.Range("C" & lngRowCounter).Value
        Exit Function
    End If

    lngRowCounter = lngRowCounter + 1
    Set rngTargetA = ws.Range("A" & lngRowCounter)
    Set rngTargetB = ws.Range("B" & lngRowCounter)
Loop

' if we don't find anything, return an empty string '
FindValue = ""


End Function

上面的函数包含两个范围值,因此您可以像使用Excel中的任何其他函数一样使用它。使用上面提供的示例,将这些单元格复制到单元格A2:C5中。接下来,在单元格A1中放置A。在单元格B1中放置1。在C1中,放=FindValue(A1,B1)。这将执行上面的代码并在找到它时返回匹配。

此外,如果您更改单元格A1或B1中的“输入值”,您的答案将相应更新。

答案 1 :(得分:2)

如果他可以在上面提到的那些(你可以从普通视图中隐藏)的左边放另一个列,你可以不使用任何VBA。

在第一个列的左侧插入一个列,并将其设置为= A1& B1,= A2& B2等。然后可以使用VLOOKUP(x,A1:Dn,4) - 其中x是字符串(他希望查找“A1”,“B2”等),n是数据集中的行数。

希望有所帮助。

答案 2 :(得分:1)

使用ADO的另一种可能性:

Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range

strFile = ActiveWorkbook.FullName

''Note HDR=No, so F1,F2 etc is used for column names
''If HDR=Yes, the names in the first row of the range
''can be used.
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set r1 = Worksheets("Sheet11").Range("F1")
Set r2 = Worksheets("Sheet11").Range("F2")
Set r3 = Worksheets("Sheet11").Range("F3")

cn.Open strCon

''Case sensitive, one text (f1), one numeric (f2) value
strSQL = "SELECT F3 FROM [Sheet11$A1:C4] WHERE F1='" & r1.Value _
       & "' AND F2=" & r2.Value

rs.Open strSQL, cn, 3, 3

''Copies all matches
r3.CopyFromRecordset rs