从一个范围中select特定的单元格并将其抵消

我需要以下代码的帮助：

Sub highlightspecificvalue() 'highlight all cells containing a specified value`enter code here` Dim fnd As String, firstfound As String Dim foundcell As Range, rng As Range Dim myrange As Range, lastcell As Range 'what value do you want to find fnd = InputBox("i want to highlight cells containing...", "highlight") 'end if cancel button is clicked or no text is entered If fnd = vbNullString Then Exit Sub Set myrange = ActiveSheet.UsedRange Set lastcell = myrange.cells(myrange.cells.Count) Set foundcell = myrange.Find(what:=fnd, after:=lastcell) 'test to see if anything was found If Not foundcell Is Nothing Then firstfound = foundcell.Address Else GoTo nothingfound End If Set rng = foundcell 'loop until cycled through all unique finds Do Until foundcell Is Nothing 'find next cell with fnd value Set foundcell = myrange.FindNext(after:=foundcell) 'add found cell to rng range variable Set rng = Union(rng, foundcell) 'test to see if cycled through to first found cell If foundcell.Address = firstfound Then Exit Do Loop If IsEmpty(cells(1,2).Offset(1, 0)) = False Then cells(1,2).Interior.Color = RGB(255, 255, 0) ElseIf IsEmpty(cells(1,2).Offset(1, 0)) = True Then cells(1,2).Interior.Color = RGB(255, 255, 255) End If 'highlight found cells yellow rng.Interior.Color = RGB(255, 255, 0) 'message MsgBox rng.cells.Count & "cell(s) were found containing: " & fnd & " found at " & rng.Address Exit Sub 'error nothingfound: MsgBox "no cells containing: " & fnd & " were found in this worksheet" End Sub 

这就是excel表格的样子：

  plug | CH | CHA | CHB | CHA | CHB ------------------------------------------------------------------------- 1 | emptycell | 9 | emptycell | 5 | 4 ------------------------------------------------------------------------- 2 | emptycell | 8 | emptycell | 4 | 5 ------------------------------------------------------------------------- 3 | emptycell | 7 | emptycell | 3 | 6 ------------------------------------------------------------------------- 4 | emptycell | 6 | emptycell | 2 | 7 ------------------------------------------------------------------------- 

我想要的代码是：

当使用input框search一个词时，只需突出显示其下有数据的单元格。 例如，如果我想查看有多less个通道，我会在input框中input“ch”，并期望仅看到第一行中的某些单元格突出显示，因为这些特定单元格下面有数据：单元格中的CHA单元格（3 ，1）应该被突出显示，因为在它下面有数据，所以在单元（5,1）中CHA，在单元（6,1）中应该CHA。

不幸的是，代码突出显示了第一行中包含“CH”的所有单词，其中包括单元格（2,1）和（4,1），即使这些列中没有数据。

我尝试了不同的循环，并没有成功。 我认为我的主要问题是来自代码结束附近的第二个if循环。

因为我是VBA的新手和学习语言，所以在阅读各种在线论坛和网站教程方面已经得到了帮助，但是，我一直在这个问题上停滞不前。

任何帮助和build议，我收到这将不胜感激。

Answer 1

将“查找所有匹配”代码放到自己的函数中更方便，这样您就可以专注于核心逻辑：

 Sub highlightspecificvalue() 'highlight all cells containing a specified value Dim fnd As String Dim rng As Range, c As Range Dim rngFound As Range, i As Long fnd = InputBox("i want to highlight cells containing...", "highlight") If fnd = vbNullString Then Exit Sub Set rng = ActiveSheet.UsedRange rng.Interior.ColorIndex = xlNone 'clear any existing color Set rngFound = FindAll(rng, fnd) 'get any matches If Not rngFound Is Nothing Then For Each c In rngFound.Cells 'check for any content for 4 cells down ' expand/contract this to suit.... If Application.CountA(c.Offset(1, 0).Resize(4, 1)) > 0 Then c.Interior.Color = vbYellow i = i + 1 End If Next c MsgBox rngFound.Cells.Count & " cell(s) were found containing: '" & _ fnd & "' found in " & rngFound.Address & vbLf & _ i & " were highlighted" Else MsgBox "No cells containing: " & fnd & " were found in this worksheet" End If End Sub 'find all matching cells in a given range Function FindAll(rngLookIn As Range, LookFor) As Range Dim rv As Range, c As Range, FirstAddress As String With rngLookIn Set c = .Find(LookFor, lookat:=xlPart) If Not c Is Nothing Then FirstAddress = c.Address Set rv = c Do Set c = .FindNext(c) If Not c Is Nothing Then Set rv = Application.Union(rv, c) Loop While Not c Is Nothing And c.Address <> FirstAddress End If End With Set FindAll = rv End Function