将突出显示从单元格扩展到行答案

【问题标题】：Extend highlight from cell to row将突出显示从单元格扩展到行
【发布时间】：2018-01-23 16:02:56
【问题描述】：

这可能是一个非常愚蠢的问题。我想指出我对 VBA 很陌生。通过到处查看互联网，我设法创建了以下代码，我用它来突出显示包含特定日期的所有单元格。我现在想调整我的代码并将突出显示扩展到包含特定日期的单元格的行，以便稍后我可以轻松地将它们复制并粘贴到新选项卡中。

Sub HighlightSpecificValue()

Dim fnd As String, FirstFound As String
Dim FoundDate As Range, rng As Range
Dim myRange As Range, LastCell As Range
Dim datetoFind As Date

'Value to be found
fnd = InputBox("Emter the date to be found", "Highlight")

'End Macro if Cancel Button is Clicked or no Text is Entered
  If fnd = vbNullString Then Exit Sub

'Convert String value to date format
 datetoFind = DateValue(fnd)

Set myRange = Sheets("Tabelle1").Range("E:E")
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundDate = myRange.Find(what:=datetoFind, _
                        after:=LastCell, _
                        LookIn:=xlFormulas, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False, _
                        SearchFormat:=False)

'Test to see if anything was found
If Not FoundDate Is Nothing Then
FirstFound = FoundDate.Address
Else
GoTo NothingFound
End If

Set rng = FoundDate

'Loop until cycled through all unique finds
Do Until FoundDate Is Nothing
'Find next cell with fnd value
  Set FoundDate = myRange.FindNext(after:=FoundDate)

'Add found cell to rng range variable
  Set rng = Union(rng, FoundDate)

'Test to see if cycled through to first found cell
  If FoundDate.Address = FirstFound Then Exit Do

Loop

'Highlight Found cells yellow
rng.Interior.Color = RGB(255, 255, 0)

'Report Out Message
MsgBox rng.Cells.Count & " cell(s) were found containing: " & fnd

Exit Sub

'Error Handler
NothingFound:
MsgBox "No cells containing: " & fnd & " were found in this worksheet"

End Sub

提前感谢您的宝贵帮助！

【问题讨论】：

标签： vba excel formatting

【解决方案1】：

使用Range 对象的EntireRow 方法。

rng.EntireRow.Interior.Color = RGB(255, 255, 0)

【讨论】：