Поиск в двух столбцах и возвращение значения из третьего VBA - PullRequest
1 голос
/ 28 января 2010

Мой коллега имеет таблицу Excel, состоящую из 3 столбцов, и хотел бы упростить их поиск.

У него есть две ячейки с одной стороны, в которые он вводит значение из первого столбца и значение из второго столбца. Он хотел бы найти в электронной таблице случаи, когда значения один и два существуют в одной и той же строке в первом и втором столбцах соответственно, а затем вернуть значение из третьего столбца, находящегося в той же строке.

Например, у меня есть таблица, подобная приведенной ниже, поэтому, если он вводит B и 2 в ячейки, BP возвращается в третью ячейку.

A 1 AP

B 2 BP

C 3 CP

Спасибо

Ответы [ 3 ]

3 голосов
/ 28 января 2010

Давайте создадим следующую функцию в новом модуле 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.Далее в ячейку А1 положить A.В ячейку B1 положить 1.В С1 положить =FindValue(A1,B1).Это выполнит приведенный выше код и вернет совпадение, если оно его найдет.

Более того, если вы измените «входные значения» для ячеек A1 или B1, ваш ответ обновится соответствующим образом.

2 голосов
/ 29 января 2010

Если он может смириться с другим столбцом слева от упомянутых выше (который вы можете скрыть от обычного просмотра), вы можете сделать это без использования VBA.

Вставьте столбец слева от первого и установите для него = A1 и B1, = A2 и B2 и т. Д. Затем вы можете использовать VLOOKUP (x, A1: Dn, 4) - где x - строка («A1», «B2» и т. Д.), Который он хочет найти, а n - это число строк в наборе данных.

Надеюсь, это поможет.

1 голос
/ 28 января 2010

Еще одна возможность использования 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...