Question

我一直在寻找一种方法来搜索冗长的Excel工作表中的数字列表，我需要找到行并用白色突出显示黑色。我正在寻找约30个号码。

到目前为止：

Sub Reformat（）

Dim SrchRng1 As Range
Dim c1 As Range, a As String

Set SrchRng1 = ActiveSheet.Range("G1", ActiveSheet.Range("G65536").End(xlUp))
Set c1 = SrchRng1.Find("217", LookIn:=xlValues)
If Not c1 Is Nothing Then
    a = c1.Address
    Do
        With c1.EntireRow
            .Font.ColorIndex = 2
            .Interior.ColorIndex = 1
        End With
        Set c1 = SrchRng1.FindNext(c1)
    Loop While c1.Address <> a
End If

Dim SrchRng2 As Range
Dim c2 As Range, b As String

Set SrchRng2 = ActiveSheet.Range("G1", ActiveSheet.Range("G65536").End(xlUp))
Set c2 = SrchRng3.Find("317", LookIn:=xlValues)
If Not c2 Is Nothing Then
    f = c2.Address
    Do
        With c2.EntireRow
            .Font.ColorIndex = 2
            .Interior.ColorIndex = 1
        End With
        Set c2 = SrchRng2.FindNext(c2)
    Loop While c2.Address <> b
End If

我需要它做什么，有没有办法压缩它和/或使它成为我所以我可以停止设置SrchRng1,2,3等......或者声明a，b，c等......字符串？

Answer 1

试试这个（请参阅内联评论以获得解释）

Sub Reformat()
    Dim ws As Worksheet
    Dim SrchRng As Range
    Dim SearchValues() As Variant
    Dim cl As Range, addr As String
    Dim i As Long

    ' load values to find into array, by whatever means you choose
    SearchValues = Array(217, 317)

    ' Define range to search. Only need to do this once
    Set ws = ActiveSheet
    With ws
        Set SrchRng = Range(.Cells(1, 7), .Cells(.Rows.Count, 7).End(xlUp))
    End With

    ' Loop thru your search values
    For i = LBound(SearchValues) To UBound(SearchValues)

        Set cl = SrchRng.Find(SearchValues(i), LookIn:=xlValues)
        If Not cl Is Nothing Then
            addr = cl.Address
            Do
                With cl.EntireRow
                    .Font.ColorIndex = 2
                    .Interior.ColorIndex = 1
                    .ClearContents
                End With
                Set cl = SrchRng.FindNext(cl)
            Loop While Not cl Is nothing ' cl.Address <> addr
        End If
    Next

End Sub

要在搜索列表中格式化行不，最好使用AutoFilter

Sub ReformatByExclusion()
    Dim ws As Worksheet
    Dim SrchRng As Range
    Dim SearchValues() As Variant
    Dim cl As Range, addr As String
    Dim i As Long

    ' load values to find into array, by whatever means you choose
    '  Note, Autofilter requires values as strings, 
    '  even when the data in the sheet are numbers
    SearchValues = Array("217", "317")

    ' Define range to search. Only need to do this once
    Set ws = ActiveSheet
    With ws
        Set SrchRng = Range(.Cells(1, 7), .Cells(.Rows.Count, 7).End(xlUp))
    End With

    Application.ScreenUpdating = False
    ' Filter for values in your search list
    SrchRng.AutoFilter Field:=1, Criteria1:=SearchValues, Operator:=xlFilterValues
    ' Format rows excluded by filter
    For Each cl In SrchRng.Cells
        With cl.EntireRow
            If .EntireRow.Hidden Then
                .Font.ColorIndex = 2
                .Interior.ColorIndex = 1
                .ClearContents
            End If
        End With
    Next
    SrchRng.AutoFilter
    Application.ScreenUpdating = True

End Sub

多个搜索/突出显示的代码压缩

1 个答案: