VBA vlookup in einem anderen Blatt

VBA vlookup in einem anderen Blatt

Ich habe zwei Tabellen (Tabelle1 und Tabellen2). Tabellen2 enthält eine Liste von Überschriften mit Zahlen entweder 1 oder 3 in benachbarten Zellen. Tabellen1 hat dieselben Überschriften mit den Werten „WAHR“ oder „FALSCH“ von Spalte A bis D. Ich möchte, dass, wenn alle Werte in einer Zeile von A:D „FALSCH“ sind, Spalte E 0 zurückgibt. Wenn eine der Zellen „WAHR“ enthält, führe ich eine vertikale Suche von Tabellen2 unter Verwendung der Überschriften durch und gebe die Zahl zurück, die neben jeder in Tabellen2 aufgelisteten Überschrift steht. Ich habe einen Code geschrieben, der einwandfrei funktioniert, jedoch für alle Zeilen die gleiche Zahl zurückgibt, die in der ersten Zeile von Tabellen2 steht. Können Sie bitte sagen, wo der Fehler liegt? Das beigefügte Bild zeigt die Ausgabe, die ich erhalte. Idealerweise sollte die letzte Zeile 1 statt 3 zurückgeben.

Beispiel aus beiden Blättern

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

verwandte Informationen