Question

我需要突出显示单元格：如果已经突出显示，则在另一个单元格中查找数字并突出显示

这是我的基本代码。

它有效，但我发现如果我有相同数量的muliples，它仍然只会突出显示第一个。我需要它能够告诉它已经突出显示并移动到下一个并突出显示那个。

Sub Find_FirstmanUALDar()
    Dim FindString8 As String
    Dim Rng8 As Range
    FindString8 = Sheets("DAR").Range("D12").Value
    If Trim(FindString1) <> "" Then
        With Sheets("GL").Range("AC:AC")
            Set Rng8 = .Find(What:=FindString8, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
             If Not Rng8 Is Nothing Then
                 Application.Goto Rng8, True
                 With Selection.Interior
                     .Pattern = xlSolid
                     .PatternColorIndex = xlAutomatic
                     .Color = 65535
                     .TintAndShade = 0
                     .PatternTintAndShade = 0
                 End With
             End If
        End With

我知道它的丑陋但请求帮助。感谢

Answer 1

Sub Tester()
    Dim rng As Range

    Set rng = FindAll(Sheets("GL").Range("AC:AC"), "test")

    If Not rng Is Nothing Then
        rng.Interior.Color = 65535
    End If

End Sub


Public Function FindAll(rng As Range, val As String) As Range
    Dim rv As Range, f As Range
    Dim addr As String

    Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.Count), _
        LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False)
    If Not f Is Nothing Then addr = f.Address()

    Do Until f Is Nothing
        If rv Is Nothing Then
            Set rv = f
        Else
            Set rv = Application.Union(rv, f)
        End If
        Set f = rng.FindNext(after:=f)
        If f.Address() = addr Then Exit Do
    Loop

    Set FindAll = rv
End Function

VBA细胞突出显示

1 个答案: