VBA vlookup на другом листе

VBA vlookup на другом листе

У меня есть два листа (Лист1 и Лист2). Лист2 содержит список заголовков с числами 1 или 3 в соседних ячейках. Лист 1 содержит те же заголовки со значениями «ИСТИНА» или «ЛОЖЬ» из столбцов A–D. Я хочу, чтобы, если все значения в строке A:D равны «ЛОЖЬ», столбец E возвращал 0. Если какая-либо из ячеек содержит «ИСТИНА», выполнить vlookup из листа2 с использованием заголовков и вернуть число, смежное с каждым заголовком, перечисленным в листе2. Я написал код, который работает нормально, однако он возвращает одно и то же число для всех строк, которые есть в первой строке листа2. Можете ли вы подсказать, где находится ошибка. Прикрепленное изображение показывает вывод, который я получаю. В идеале последняя строка должна возвращать 1 вместо 3.

Образец из обоих листов

Sub UpdateOutput()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim headersRange As Range
    Dim dataRange As Range
    Dim outputRange As Range
    Dim headersCell As Range
    Dim dataRow As Range
    Dim lookupValue As String
    Dim lookupResult As Variant
    Dim lr As Long
    
    Set ws1 = ThisWorkbook.Worksheets("QMform")
    Set ws2 = ThisWorkbook.Worksheets("NameList")
    Set headersRange = ws2.Range("A2:B5")
    
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lr
    Set dataRange = ws1.Range("A" & i & ":D" & i)
    Set outputRange = ws1.Range("E" & i & ":E" & i)
    
    For Each dataRow In dataRange.Rows

        If Application.WorksheetFunction.CountIf(dataRow, "TRUE") = 0 Then
            outputRange.Cells(dataRow.Row - dataRange.Row + 1).Value = 0
        Else
            For Each headersCell In headersRange
                lookupValue = headersCell.Value
                
                If Application.WorksheetFunction.CountIf(dataRow, "TRUE") > 0 Then
                    lookupResult = Application.Vlookup(lookupValue, headersRange.Offset(0, 1), 2, False)

                    If Not IsError(lookupResult) Then

                        outputRange.Cells(dataRow.Row - dataRange.Row + 1).Value = lookupResult
                    End If
                End If
            Next headersCell
        End If
      Next dataRow
    Next i
    
End Sub

Связанный контент