Question

例如，我想看看从B10到B colomn结尾的每个单元格是否以＆＃34; @ yahoo.com＆＃34;，＆＃34; @ gmail.com＆＃34;，＆＃34; @ rediffmail.com＆＃34 ;.如果没有，那么它应该为特定的细胞着色。

以下是我的尝试：

以下是缺点：

搜索整张纸，而不是一列。
它着色整行，而不是特定的单元格
我想突出显示不以上述域名结尾的单元格。

Answer 1

你可以用这个：
1）使用array存储搜索关键字的变体：

Sub test()
    Dim cl As Range, Data As Range
    Dim searchTerms, k, trigger%
    searchTerms = Array("yahoo.com", "gmail.com", "rediff.co")
    Set Data = Range("B10:B" & [B:B].Find("*", , , , xlByRows, xlPrevious).Row)
    For Each cl In Data
        trigger = 0
        For Each k In searchTerms
            If LCase(cl.Value2) Like "*" & LCase(k) Then
                trigger = 1
                Exit For
            End If
        Next k
        If trigger = 0 Then
            cl.Interior.ColorIndex = 7
        Else
            cl.Interior.Pattern = xlNone
        End If
    Next cl
End Sub

2）使用搜索键范围的变体：

Sub test2()
    Dim cl As Range, Data As Range
    Dim k As Range, searchTerms As Range, trigger%
    Dim S1 As Worksheet, S2 As Worksheet

    Set S1 = Sheets("Sheet1") ' change to sheetname with data for comparing
    Set S2 = Sheets("Sheet2") ' chanfe to sheetname with search keys

    Set Data = S1.Range("B10:B" & S1.[B:B].Find("*", , , , xlByRows, xlPrevious).Row)
    Set searchTerms = S2.[A1:A3] '"yahoo.com", "gmail.com", "rediff.co"
    For Each cl In Data
        trigger = 0
        For Each k In searchTerms
            If LCase(cl.Value2) Like "*" & LCase(k.Value2) Then
                trigger = 1: Exit For
            End If
        Next k
        If trigger = 0 Then
            cl.Interior.ColorIndex = 7
        Else
            cl.Interior.Pattern = xlNone
        End If
    Next cl
End Sub

3）使用scripting.dictionary的变体和搜索字词的范围：

Sub test3()
    Dim cl As Range, Data As Range, Cnt As Long
    Dim S1 As Worksheet, S2 As Worksheet
    Dim searchTerms As Object, WrdArray() As String
    Set searchTerms = CreateObject("Scripting.Dictionary")
    searchTerms.comparemode = vbTextCompare

    Set S1 = Sheets("Sheet1") ' change to sheetname with data for comparing
    Set S2 = Sheets("Sheet2") ' chanfe to sheetname with search keys

    For Each cl In S2.[A1:A4] '"yahoo.com", "gmail.com", "rediff.co", "internal.yahoo.com"
        If Not searchTerms.exists(cl.Value2) Then
            searchTerms.Add cl.Value2, Nothing
        End If
    Next cl

    Set Data = S1.Range("B10:B" & S1.[B:B].Find("*", , , , xlByRows, xlPrevious).Row)
    Cnt = 0
    For Each cl In Data
        WrdArray() = Split(cl.Value2, "@")
        If Not searchTerms.exists(Split(cl.Value2, "@")(UBound(WrdArray()))) Then
            cl.Interior.Color  = vbYellow: Cnt = Cnt + 1
        Else
            cl.Interior.Pattern = xlNone
        End If
    Next cl
    If Cnt > 0 Then 
        Msgbox "Total count of incorrect entries is [" & Cnt & _ 
        "] all discrepancies have been highlighted with Yellow!"
    End If
End Sub

查找以数组中定义的单词结尾的文本

1 个答案: