使用 VBA 匹配两个单独列中的值

Question

我正在尝试编写一个 VBA 代码，它可以告诉我付款 ID 是否同时存在于 Our_Data 和 Customer_Data 范围中，以及与该付款 ID 关联的所有保费是否都存在于这两个范围中。

不幸的是，到目前为止我所尝试的一切都只能读取付款 ID。它无法区分 2.70 溢价的付费 ID 和 12.35 溢价的付费 ID。

如果两个范围包含相同的数据，则所需的输出将在“匹配”的每一行中都有一个“Y”。如果其中一个存在 payID/premium，而另一个不存在，则 N 将相应出现。

下面的代码是我到目前为止所得到的。虽然它正确地在两个 12.35 溢价旁边标记了 Y，但它仍然在两个 2.70 溢价旁边标记了 N，尽管事实上它们存在于两个范围内。

任何帮助将不胜感激。

最好的，

Sub payIDRecon1()
    Dim eRow1 As Long, eRow2 As Long
    Dim cell1 As Range, cell2 As Range
    Dim rngOurData As Range, rngCustData As Range
    Dim data As Worksheet
    Dim noMatch As Worksheet
    Dim payID1 As Variant, payID2 As Variant
    Dim pay_id_row As Long
    pay_id_row = 3

    Set data = ThisWorkbook.Sheets("Data")
    Set noMatch = ThisWorkbook.Sheets("No_Match_Pay_ID")

    ' Find the last row in columns A and G
    eRow1 = data.Cells(data.Rows.Count, 1).End(xlUp).row
    eRow2 = data.Cells(data.Rows.Count, 7).End(xlUp).row

    ' Set the ranges for our data and customer data
    Set rngOurData = data.Range("A3:A" & eRow1)
    Set rngCustData = data.Range("G3:G" & eRow2)

    ' Loop through each cell in rngOurData
    For Each cell1 In rngOurData
        payID1 = cell1.Value
        
        ' Reset flag for each iteration
        Dim foundInCustData As Boolean
        foundInCustData = False
        
        ' Loop through each cell in rngCustData
        For Each cell2 In rngCustData
            payID2 = cell2.Value
            
            ' Check if payID1 exists in rngCustData
            If payID1 = payID2 Then
                foundInCustData = True
                
                ' Check if corresponding premium matches
                If cell1.Offset(0, 4).Value = cell2.Offset(0, 3).Value Then
                    cell1.Offset(0, 5).Value = "Y"
                Else
                    cell1.Offset(0, 5).Value = "N"
                    
                    With noMatch
                    
                        .Range("A" & pay_id_row).Value = data.Cells(cell1.row, 1).Value
                        .Range("B" & pay_id_row).Value = data.Cells(cell1.row, 2).Value
                        .Range("C" & pay_id_row).Value = data.Cells(cell1.row, 3).Value
                        .Range("D" & pay_id_row).Value = data.Cells(cell1.row, 4).Value
                        .Range("E" & pay_id_row).Value = data.Cells(cell1.row, 5).Value
                        pay_id_row = pay_id_row + 1
                        
                    End With
                    
                End If
                
                Exit For ' Exit the inner loop once a match is found
                
            End If
            
        Next cell2
        
        ' If payID1 not found in rngCustData, mark it as such
        If Not foundInCustData Then
            cell1.Offset(0, 5).Value = "Not Found in Customer Data"
            
            With noMatch
            
                .Range("A" & pay_id_row).Value = data.Cells(cell1.row, 1).Value
                .Range("B" & pay_id_row).Value = data.Cells(cell1.row, 2).Value
                .Range("C" & pay_id_row).Value = data.Cells(cell1.row, 3).Value
                .Range("D" & pay_id_row).Value = data.Cells(cell1.row, 4).Value
                .Range("E" & pay_id_row).Value = data.Cells(cell1.row, 5).Value
                pay_id_row = pay_id_row + 1
            
            End With
            
        End If
        
    Next cell1
    
    ' Reset rngCustData for the second loop
    Set rngCustData = data.Range("G3:G" & eRow2)
    
    pay_id_row = 3

    ' Loop through each cell in rngCustData
    For Each cell2 In rngCustData
        payID2 = cell2.Value
        
        ' Reset flag for each iteration
        Dim foundInOurData As Boolean
        foundInOurData = False
        
        ' Loop through each cell in rngOurData
        For Each cell1 In rngOurData
            payID1 = cell1.Value
            
            ' Check if payID2 exists in rngOurData
            If payID1 = payID2 Then
                foundInOurData = True
                
                ' Check if corresponding premium matches
                If cell2.Offset(0, 3).Value = cell1.Offset(0, 4).Value Then
                    cell2.Offset(0, 4).Value = "Y"
                Else
                    cell2.Offset(0, 4).Value = "N"
                    
                    With noMatch
            
                        .Range("I" & pay_id_row).Value = data.Cells(cell2.row, 7).Value
                        .Range("J" & pay_id_row).Value = data.Cells(cell2.row, 8).Value
                        .Range("K" & pay_id_row).Value = data.Cells(cell2.row, 9).Value
                        .Range("L" & pay_id_row).Value = data.Cells(cell2.row, 10).Value
                        pay_id_row = pay_id_row + 1
            
                    End With
                    
                End If
                
                Exit For ' Exit the inner loop once a match is found
                
            End If
            
        Next cell1
        
        ' If payID2 not found in rngOurData, mark it as such
        If Not foundInOurData Then
            cell2.Offset(0, 4).Value = "Not Found in Our Data"
            
            With noMatch
            
                .Range("I" & pay_id_row).Value = data.Cells(cell2.row, 7).Value
                .Range("J" & pay_id_row).Value = data.Cells(cell2.row, 8).Value
                .Range("K" & pay_id_row).Value = data.Cells(cell2.row, 9).Value
                .Range("L" & pay_id_row).Value = data.Cells(cell2.row, 10).Value
                pay_id_row = pay_id_row + 1
            
            End With
            
        End If
        
    Next cell2
    
End Sub 

Answer 1

• 我猜左边的 Premium 列有数字格式，假设格式规则显示小数点后 2 位数字。
• 如果单元格值为 2.699，则显示 2.70。正确的 Premium 电池是 2.7。
• 以下

  If

  条件被评估为 False。也就是说，2.70（实际值为 2.699）不等于 2.7。

If cell1.Offset(0, 4).Value = cell2.Offset(0, 3).Value Then

请尝试比较两种优质cols之间的差异。

If Abs(Val(cell1.Offset(0, 4).Value) - Val(cell2.Offset(0, 3).Value)) <= 0.01 Then