Найти значение ячейки (текст) на основе двух критериев - PullRequest
Новая
       17

Найти значение ячейки (текст) на основе двух критериев

0 голосов
/ 07 июня 2018

Я провел большую часть своего дня в поисках способа вернуть текстовое значение в ячейку, основанную на двух столбцах.Я пытаюсь сопоставить значения от Листа1, столбцы A и F до листа2, возвращая значение в столбце B, где эти два соответствуют листу 1.

Для визуализации: 

   Sheet 1                      Sheet 2


 A           F                A       B        F

 x           b                x       c        y
 x           g                x       k        b

Есть ли способ использовать VLOOKUP для этого, что я пропустил?Я вполне уверен, что упускаю что-то простое, но мне трудно.

Заранее спасибо!

Ответы [ 2 ]

0 голосов
/ 07 июня 2018

Следующий нижний индекс выполняет именно то, что вы просили: 

Sub DoThaThing()
    Dim i As Long, lastRow1 As Long
    Dim Sheet1A As Variant, Sheet1F As Variant, firstFound As String
    Dim findData As Range
    lastRow1 = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    For i = 1 To lastRow1 Step 1
        Sheet1A = Sheets("Sheet1").Cells(i, "A").Value
        Sheet1F = Sheets("Sheet1").Cells(i, "F").Value
        Set findData = Sheets("Sheet2").Columns("A:A").Find(What:=Sheet1A, _
                       After:=Sheets("Sheet2").Range("A1"), _
                       LookIn:=xlValues, _
                       LookAt:=xlWhole, _
                       SearchOrder:=xlByColumns, _
                       SearchDirection:=xlNext, _
                       MatchCase:=False, _
                       SearchFormat:=False)
        If Not findData Is Nothing Then
            'First instance found, loop if needed
            firstFound = findData.Address
            Do
            'Found, check Column F (5 columns over with offset)
                If findData.Offset(0, 5).Value = Sheet1F Then
                    'A and F match get data from B (1 column over with offset)
                    Sheets("Sheet1").Cells(i, "B").Value = findData.Offset(0, 1).Value
                    Exit Do
                Else
                    'F doesnt match, search next and recheck
                    Set findData = Sheets("Sheet2").Columns("A:A").FindNext(findData)
                End If
            Loop While Not findData Is Nothing And firstFound <> findData.Address
        Else
            'Value on Sheet 1 Column A was not found on Sheet 2 Column A
            Sheets("Sheet1").Cells(i, "B").Value = "NOT FOUND"
        End If
    Next
End Sub

Редактировать: Исправлен бесконечный цикл.

0 голосов
/ 07 июня 2018

попробуйте этот код, он работает для меня: 

Option Explicit
Sub test()


' Active workbook
Dim wb As Workbook
Set wb = ThisWorkbook
Dim i As Long
Dim j As Long

'*******************************************
'Adapt this vars


'define your sheets
Dim ws_1 As Worksheet
Dim ws_2 As Worksheet
Set ws_1 = wb.Sheets("Feuil1") 'change name of the sheet to complete
Set ws_2 = wb.Sheets("Feuil2") 'change name of the sheet with all data

'definie the last Rows
Dim lastRow_ws1 As Long
Dim lastRow_ws2 As Long

lastRow_ws1 = ws_1.Range("A" & Rows.Count).End(xlUp).Row + 1 'if you need, adjust column to find last row
lastRow_ws2 = ws_2.Range("A" & Rows.Count).End(xlUp).Row + 1 'if you need, adjust column to find last row
'*******************************************

Dim keyMach1 As String
Dim keyMach2 As String

For j = 1 To lastRow_ws1

    For i = 1 To lastRow_ws2

    Dim keySearch As String
    Dim keyFind As String

    keySearch = ws_1.Cells(j, 1).Value & ws_1.Cells(j, 6).Value 'I concat both cell to create o key for the search
    keyFind = ws_2.Cells(i, 1).Value & ws_1.Cells(i, 6).Value ' idem to match

    If keySearch = keyFind Then
         ws_1.Cells(j, 2).Value = ws_2.Cells(i, 2).Value
    End If


    Next i

Next j

End Sub
...