簡體   English   中英

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

[英]VBA Excel matching criteria across sheets and columns

我試圖比較同一工作簿中兩張紙上的數據。 第一頁包含一個單獨的地址列表,第二頁包含一個地址范圍列表,其中一列是起始地址范圍,第二列是結束地址范圍。 例如

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

遍歷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之前

之前的工作表

工作表2

工作表2

Sheet1之后

工作表1之后

@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上的參考數據

工作表2

Sheet1上的匹配結果

工作表1

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM