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

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/2156099/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 11:16:30  来源:igfitidea点击:

Searching two columns and returning value from third VBA

excelvbaexcel-vba

提问by manemawanna

A colleague of mine has an excel spreadsheet made up of 3 columns and would like to make searching them easier.

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

What he has is two cells off to one side that he enters a value from column one into and a value from column two into. What he would like to do is search the spreadsheet for instances where value one and two exist in the same row within column one and two respectively and then return the value from column three that resides in the same row.

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

For example I have a table like the one shown below, so if he enters B and 2 into the cells BP is then returned to a third cell.

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

A 1 AP

1个AP

B 2 BP

B 2 BP

C 3 CP

C 3 CP

Thanks

谢谢

回答by Ben McCormack

Let's create the following function in a new Excel module:

让我们在新的 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

The above function takes in two range values, so you can use it like you would use any other function in Excel. Using the example you provided above, copy those cells into cells A2:C5. Next, in cell A1 put A. In cell B1 put 1. In C1, put =FindValue(A1,B1). This will execute the code above and return a match if it finds it.

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

Furthermore, if you change the "input values" from cells A1 or B1, your answer will update accordingly.

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

回答by Paul Rayner

If he can put up with another colum to the left of the ones mentioned above (which you can hide from normal view), you can do it without using any VBA.

如果他能忍受上面提到的左边的另一个列(你可以从正常视图中隐藏),你可以在不使用任何 VBA 的情况下做到这一点。

Insert a colum to the left of the first one, and set it to =A1&B1, =A2&B2 etc. You can then use VLOOKUP(x,A1:Dn,4) - where x is the string ("A1", "B2", etc.) that he wants to look up, and n is the number of rows in the dataset.

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

Hope that helps.

希望有帮助。

回答by Fionnuala

Another possibility using ADO:

使用 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