另一張表中的 VBA vlookup

另一張表中的 VBA vlookup

我有兩張表(表 1 和表 2)。 Sheet2 具有標題列表,相鄰儲存格中的數字為 1 或 3。表1 具有相同的標題,從A 列到D 列的值為“TRUE”或“FALSE”。儲存格包含“TRUE”,使用標題從sheet2進行vlookup,並傳回與sheet2中列出的每個標題相鄰的數字。我已經編寫了一個工作正常的程式碼,但是它為sheet2第一行中的所有行返回相同的數字。你能建議一下錯誤在哪裡嗎?附圖顯示了我得到的輸出。理想情況下,最後一行應傳回 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

相關內容