跨工作表和列的 VBA Excel 匹配条件

Question

我正在尝试比较同一工作簿中两个工作表的数据。第一张表有一个单独的地址列表，第二张有一个地址范围列表，其中一列是起始地址范围，第二列是结束地址范围。例如

sheet1: 
123 main st
230     main st
456 main st


Sheet2: 
100 200 main st
400 500 main st

如何确定单个地址是否在地址范围内？我有以下与街道名称匹配的代码，但我需要为该地址范围内的街道编号添加条件，否则不匹配。在此示例中，sheet1 第 1 行和第 3 行匹配，而 sheet1 第 2 行不匹配。

Sub matchcolumns()

Dim I, total, fRow As Integer
Dim found As Range

total = Sheets(1).Range("A" & Rows.Count).End(xlUp).row

For I = 2 To total

    answer1 = Worksheets(2).Range("A" & I).Value
    Set found = Sheets(1).Columns("H:H").Find(what:=answer1) 'finds a match

        If Not found Is Nothing Then
            Debug.Print "MATCH"
        Else
            Debug.Print "NO MATCH"
        End If
Next I

End Sub

Answer 1

循环Sheet1并检查Sheet2中是否存在。在这种情况下，MATCH 或 NO MATCH 写入第三列。干杯。

Option Explicit

Public Sub check()

    Dim vDataSheet As Worksheet
    Dim vDataRow As Long

    Dim vRefSheet As Worksheet
    Dim vRefRow As Long

    Dim vFound As Boolean

    Set vDataSheet = Application.ActiveWorkbook.Sheets("Sheet1")
    Set vRefSheet = Application.ActiveWorkbook.Sheets("Sheet2")

    vDataRow = 1
    While vDataSheet.Cells(vDataRow, 1) <> ""

        vFound = False
        vRefRow = 1
        While vRefSheet.Cells(vRefRow, 1) <> "" And Not vFound

            If vDataSheet.Cells(vDataRow, 1) >= vRefSheet.Cells(vRefRow, 1) And _
               vDataSheet.Cells(vDataRow, 1) <= vRefSheet.Cells(vRefRow, 2) And _
               vDataSheet.Cells(vDataRow, 2) = vRefSheet.Cells(vRefRow, 3) Then
                vFound = True
            End If

            vRefRow = vRefRow + 1
        Wend

        If vFound Then
            vDataSheet.Cells(vDataRow, 3) = "MATCH"
        Else
            vDataSheet.Cells(vDataRow, 3) = "NO MATCH"
        End If

        vDataRow = vDataRow + 1
    Wend

End Sub

Sheet1 之前

Sheet2

Sheet1 之后

Answer 2

@Mikku 感谢我将数据读取为格式不佳的列...而不是单个列。我的错。这是处理单列数据的更新代码。我对数据类型做了简单的假设（并且将街道号码作为字符串保留，因为我不知道它们的真正结构）等等......但适用于有问题的数据示例：

Option Explicit

Public Sub check()

    Dim vDataSheet As Worksheet
    Dim vDataRow As Long

    Dim vStreetNumber As String
    Dim vStreetName As String

    Dim vRefSheet As Worksheet
    Dim vRefRow As Long

    Dim vFromNumber As String
    Dim vToNumber As String

    Dim vFirstSpace As Long
    Dim vSecondspace As Long

    Dim vRefName As String

    Dim vFound As Boolean

    Set vDataSheet = Application.ActiveWorkbook.Sheets("Sheet1")
    Set vRefSheet = Application.ActiveWorkbook.Sheets("Sheet2")

    vDataRow = 1
    While vDataSheet.Cells(vDataRow, 1) <> ""

        vStreetNumber = Left(vDataSheet.Cells(vDataRow, 1), InStr(1, vDataSheet.Cells(vDataRow, 1), " ") - 1)
        vStreetName = Right(vDataSheet.Cells(vDataRow, 1), Len(vDataSheet.Cells(vDataRow, 1)) - InStr(1, vDataSheet.Cells(vDataRow, 1), " "))

        vFound = False
        vRefRow = 1
        While vRefSheet.Cells(vRefRow, 1) <> "" And Not vFound

            vFirstSpace = InStr(1, vRefSheet.Cells(vRefRow, 1), " ")
            vFromNumber = Left(vRefSheet.Cells(vRefRow, 1), vFirstSpace - 1)

            vSecondspace = InStr(vFirstSpace + 1, vRefSheet.Cells(vRefRow, 1), " ")
            vToNumber = Mid(vRefSheet.Cells(vRefRow, 1), vFirstSpace + 1, vSecondspace - vFirstSpace - 1)

            vRefName = Right(vRefSheet.Cells(vRefRow, 1), Len(vRefSheet.Cells(vRefRow, 1)) - vSecondspace)

            If vStreetNumber >= vFromNumber And vStreetNumber <= vToNumber And _
               vStreetName = vRefName Then
                vFound = True
            End If

            vRefRow = vRefRow + 1
        Wend

        If vFound Then
            vDataSheet.Cells(vDataRow, 2) = "MATCH"
        Else
            vDataSheet.Cells(vDataRow, 2) = "NO MATCH"
        End If

        vDataRow = vDataRow + 1
    Wend

End Sub

Sheet2

上的参考数据

Sheet1

上的匹配结果