2012-08-23 96 views
1

我需要突出显示单元格:如果已经强调然后在另一个细胞数找到并强调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 

我知道它的丑陋,但请大家帮忙。 谢谢

回答

4
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 
+1

+1虽然我也喜欢'Loop While'而不是如果测试退出循环:) – brettdj