VBA单元格突出显示

我需要突出显示单元格:如果已经突出显示,则在另一个单元格中查找编号并突出显示

这是我非常基本的代码。

它的工作原理,但我发现,如果我有相同数量的多个它仍然只会突出显示第一个发现。 我需要它能够说明它已经突出显示并转到下一个,并突出显示一个。

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 

我知道它丑,但请帮助。 谢谢

 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