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

Question

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

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

上的匹配结果

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

VBA Excel matching criteria across sheets and columns

excel

vba

matching