将单元格值与参考值进行比较并查找部分匹配

时间:2014-03-05 08:25:16

标签: vba excel-vba excel

我正在寻找一种方法来将单元格值列表与某个参考值进行比较。如果我只需要比较我知道如何实现这些值的值。但这里是踢球者:我怎样才能找到部分匹配?例如:参考值应为“良好”。如果这些单元格的值也是“好的”,那么它应该被视为匹配。如果单元格值是“Mr. goodcat”,那么它也应该被认为是匹配。我最好的猜测是将原始值引用到字符串变量,并在可能的情况下输入一些“*”。 由于我无法发布一些代码,我不需要你给我完整的答案,但是正确方向的一点是非常好的。先谢谢你们。

编辑:我已经输入了我的最终代码。一个简短的解释:它遍历Sheet2中的值,并将它们与Sheet 1中第J列中的值进行比较。如果找到(部分)匹配,则会突出显示该单元格。

Sub CompareValues()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws1Lrow As Long
Dim ws2Lrow As Long
Dim i As Integer
Dim x As Integer
Dim k As Integer
Dim reference As String

Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")

ws1Lrow = Worksheets("Sheet1").Range("A" & Worksheets("Sheet1").Rows.Count).End(xlUp).Row
ws2Lrow = Worksheets("Sheet2").Range("A" & Worksheets("Sheet2").Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False

For i = 1 To ws2Lrow Step 1
    ws2.Select
        Cells(i, 1).Select
        reference = ActiveCell

    ws1.Select
        For x = 2 To ws1Lrow
            k = InStr(1, Cells(x, 10), reference, vbTextCompare)
            If k > 0 Then
                Cells(x, 10).Interior.ColorIndex = 6
            End If
        Next x
Next i


End Sub

1 个答案:

答案 0 :(得分:1)

这个怎么样?

Dim I As Integer
I = InStr(1, "Mr. goodcat", "good", vbTextCompare)
If I > 0 Then
    ' Match
Else
    ' No Match
End

这是更高级的功能,允许在中间使用通配符:

Function PatternMatch(ByVal SearchIn As String, ByVal Pattern As String) As Boolean

    If Len(SearchIn) = 0 Or Len(Pattern) = 0 Then
        PatternMatch = False
        Exit Function
    End If

    Dim Position As Integer
    Dim MatchFirst As Boolean
    Dim MatchLast As Boolean
    Dim Chunks() As String

    MatchFirst = (Left(Pattern, 1) <> "*")
    MatchLast = (Right(Pattern, 1) <> "*")

    Chunks = Split(Pattern, "*")
    LastChunkIndex = UBound(Chunks)

    If MatchFirst Then
        If Not (Left(SearchIn, Len(Chunks(0))) = Chunks(0)) Then
            PatternMatch = False
            Exit Function
        End If
    End If

    If MatchLast Then
        If Not (Right(SearchIn, Len(Chunks(LastChunkIndex))) = Chunks(LastChunkIndex)) Then
            PatternMatch = False
            Exit Function
        End If
    End If

    Position = 1

    For Each Chunk In Chunks
        ChunkLength = Len(Chunk)
        If ChunkLength > 0 Then
            NextPosition = InStr(Position, SearchIn, Chunk, vbTextCompare)
            If NextPosition > 0 And NextPosition >= Position Then
                Position = NextPosition + ChunkLength
            Else
                PatternMatch = False
                Exit Function
            End If
        End If
    Next Chunk

    PatternMatch = True

End Function