別のシートでの VBA vlookup

別のシートでの VBA vlookup

シートが 2 つあります (Sheet1 と Sheet2)。Sheet2 には、隣接するセルに 1 または 3 の数字が入ったヘッダーのリストがあります。Sheet 1 には、列 A から D まで、値が "TRUE" または "FALSE" の同じヘッダーがあります。A:D の行のすべての値が "FALSE" の場合、列 E は 0 を返すようにしたいです。いずれかのセルに "TRUE" が含まれている場合は、ヘッダーを使用して sheet2 から vlookup を実行し、sheet2 にリストされている各ヘッダーに隣接する数字を返します。正常に動作するコードを記述しましたが、sheet2 の最初の行にあるすべての行に同じ数字が返されます。エラーの場所を教えていただけますか。添付の画像は、私が得ている出力を示しています。理想的には、最後の行は 3 ではなく 1 を返す必要があります。

両方のシートからのサンプル

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

関連情報