excel 仅突出显示多个表行而不是整行

kokeuurv  于 2023-06-25  发布在  其他
关注(0)|答案(3)|浏览(107)

是否有一种方法可以只突出显示表格范围内的多个活动单元格行,而不是整个工作表行?我尝试过条件格式,但它不适用于多个活动单元格选择。
这是我目前的工作代码。谢谢你

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.ScreenUpdating = False

With Target
  EntireRow.Interior.ColorIndex = 36
End With

Application.ScreenUpdating = True

End Sub
pengsaosao

pengsaosao1#

我建议采取以下措施:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Table As ListObject
    Set Table = Target.ListObject
    
    If Not Table Is Nothing Then
        Dim ColorRange As Range
        Set ColorRange = Application.Intersect(Table.DataBodyRange, Target.EntireRow)
        If Not ColorRange Is Nothing Then
            ColorRange.Interior.ColorIndex = 36
        End If
    End If
End Sub

Target.ListObject将指向所选单元格的表,而不必对表名进行硬编码。另外,如果你使用IntersectTable.DataBodyRange,它不会给表的标题上色,而只会给数据区域上色。使用Intersect时,建议在使用前检查两个范围是否在所有If Not ColorRange Is Nothing Then处相交,否则很容易出错。
请注意,上面的代码将向表中添加彩色行。

如果您只想为当前选择的行着色,请使用以下代码:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Table As ListObject
    Set Table = Target.ListObject
    
    If Not Table Is Nothing Then
        ' decolorize prevously colored rows
        With Table.DataBodyRange.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        
        Dim ColorRange As Range
        Set ColorRange = Application.Intersect(Table.DataBodyRange, Target.EntireRow)
        If Not ColorRange Is Nothing Then
            ColorRange.Interior.ColorIndex = 36
        End If
    End If
End Sub

jecbmhm3

jecbmhm32#

高亮显示所选表格单元格的表格行

  • 在屏幕截图中,使用Ctrl+右键单击选择单元格。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Const CLEAR_EXISTING_HIGHLIGHTS As Boolean = True

    ' Reference the table's data range (exclude headers).
    
    Dim trg As Range, rCount As Long
    
    ' For a table (not Excel (structured) table) starting in cell 'A1':
    With Me.Range("A1").CurrentRegion
        rCount = .Rows.Count - 1
        If rCount = 0 Then Exit Sub ' no data
        Set trg = .Resize(rCount).Offset(1)
    End With
    
    ' For an Excel (structured) table:
'    With Me.ListObjects("Table1")
'        If .DataBodyRange Is Nothing Then Exit Sub ' empty table
'        Set trg = .DataBodyRange
'    End With

    ' Consider only cells in the table's data range.
    
    Dim irg As Range: Set irg = Intersect(trg, Target)
    If irg Is Nothing Then Exit Sub
    
    ' Clear existing highlights.
    
    If CLEAR_EXISTING_HIGHLIGHTS Then
        trg.Interior.ColorIndex = xlNone
    End If
    
    ' Apply new highlights.
    
    Set irg = Intersect(trg, irg.EntireRow)
    irg.Interior.ColorIndex = 36

End Sub
3phpmpom

3phpmpom3#

一种方法是获取所选行和表的交集。将“Table1”替换为表的名称。
我还添加了一个建议,如果你想从你以前的选择清除颜色。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.ScreenUpdating = False

'ActiveSheet.UsedRange.Interior.ColorIndex = 0  'Use this if you want to clear the color from your previous selection first

With Target
  Intersect(ListObjects("Table1").Range, .EntireRow).Interior.ColorIndex = 36
End With

Application.ScreenUpdating = True

End Sub

相关问题