[分享]自动为当前单元格所在行和列加上颜色

fanjy · 发表于 2006-10-27 13:29

自动为当前单元格所在行和列加上颜色
分类:ExcelVBA>>Web资源(vbaexpress)>>技术技巧
当光标定位在工作表中某单元格中时，Excel自动为该单元格或者该单元格所在的行或列加上颜色，这个技巧可用于在工作表中突出显示当前单元格及其所在的行和列，以强调数据，并方便阅读。下面介绍了实现此功能的几种方法。

fanjy · 发表于 2006-10-27 13:30

使用条件格式
下面将使用条件格式实现当前单元格和当前单元所在行或列突出显示的效果。在公式中使用了Cell函数，并将ScreenUpdation属性的值设置为True以实现屏幕更新。
在ThisWorkbook模块中输入如下代码：
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.ScreenUpdating = True
End Sub
当然，如果只想在工作表中实现突出显示的效果，将Application.ScreenUpdating = True代码输入到Worksheet_SelectionChange事件中。

fanjy · 发表于 2006-10-27 13:31

接下来，在Excel中选择菜单“格式——条件格式”命令，弹出“条件格式”对话框。在“条件”下拉框中选择“公式”并在右侧中输入下面相应的公式，然后点击“格式”按钮，设置相应的格式，完成后，按“确定”按钮。
下面是相应的公式及其作用：
(1)公式“=CELL("address")=ADDRESS(ROW(),COLUMN())”，突出活动单元格，如下图1所示。

图1

[此贴子已经被作者于2006-10-27 13:42:13编辑过]

fanjy · 发表于 2006-10-27 13:32

(2)公式“=CELL("row")=ROW()”，突出单元格所在行，如下图2所示。

图2

[此贴子已经被作者于2006-10-27 13:42:40编辑过]

fanjy · 发表于 2006-10-27 13:33

(3)下面的公式突出到当前单元格为止的相应行和列，呈反L形，如下图3所示。
“=OR(AND(CELL("row")=ROW(),CELL("col")+1>COLUMN()),AND(CELL("col")=COLUMN(),CELL("row")+1>ROW()))”

图3

[此贴子已经被作者于2006-10-27 13:43:06编辑过]

fanjy · 发表于 2006-10-27 13:35

(4)在“条件格式”对话框中对所选单元格区域设置两个如下所列的公式条件，将呈反L形突出显示到当前单元格为止的相应行和列，且当前单元格背景色改变、字体加粗显示，如下图4所示。
“=CELL("address")=ADDRESS(ROW(),COLUMN())”
“=OR(AND(CELL("row")=ROW(),CELL("col")+1>COLUMN()),AND(CELL("col")=COLUMN(),CELL("row")+1>ROW()))”

EnGR5owf.rar (8.3 KB, 下载次数: 272)

fanjy · 发表于 2006-10-27 13:36

使用VBA代码
(1) 突出显示至当前单元格所在的行和列，呈反L形。在需要设置此功能的工作表模块中输入下面的代码：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iColor As Integer
'注:如果工作表中有想要保留的条件格式,则不要使用本程序
'忽略用户选择单元格区域时可能产生的错误
On Error Resume Next
iColor = Target.Interior.ColorIndex
If iColor < 0 Then
    iColor = 36
Else
     iColor = iColor + 1
End If
'避免字体颜色与突出色相同
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1
Cells.FormatConditions.Delete
'水平突出色
With Range("A" & Target.Row, Target.Address)
    .FormatConditions.Add Type:=2, Formula1:="TRUE"
    .FormatConditions(1).Interior.ColorIndex = iColor
End With
'垂直突出色
With Range(Target.Offset(1 - Target.Row, 0).Address & ":" & _
     Target.Offset(-1, 0).Address)
     .FormatConditions.Add Type:=2, Formula1:="TRUE"
     .FormatConditions(1).Interior.ColorIndex = iColor
End With
End Sub
注意，此代码运行后，将清除所在工作表中含有的条件格式。示例文档见用颜色自动突出显示当前单元格行列1.xls。

NwwmdrnL.rar (7.46 KB, 下载次数: 216)

fanjy · 发表于 2006-10-27 13:37

(2) 突出显示当前单元格所在的行和列。在需要设置此功能的工作表模块中输入下面的代码：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'可带条件格式,但不能复制/剪切/粘贴操作
With Target.Parent
    .Cells.Interior.ColorIndex = 0
    .Columns(Target.Column).Cells.Interior.ColorIndex = 35
    .Rows(Target.Row).Cells.Interior.ColorIndex = 35
End With
End Sub
注意，此代码运行后，在当前工作表中不能进行复制、剪切和粘贴功能。示例文档见用颜色自动突出显示当前单元格行列2.xls。

lqWfomvA.rar (5.93 KB, 下载次数: 189)

fanjy · 发表于 2006-10-27 13:39

(3) 突出显示当前单元格所在的行和列。在需要设置此功能的工作表模块中输入下面的代码：
Private Sub Worksheet_Change(ByVal target As Range)
If Application.CutCopyMode <> False Then
    Application.CutCopyMode = False
    Call ColorBand(target)
End If
End Sub
‘- - - - - - - - - - - - - - - - - - - - -
Private Sub Worksheet_SelectionChange(ByVal target As Range)
If Application.CutCopyMode = False Then
    Call ColorBand(target)
Else
    Exit Sub
End If
End Sub
‘- - - - - - - - - - - - - - - - - - - - -
Private Sub ColorBand(ByVal rngTarget As Range)
With rngTarget.Parent
    .Cells.Interior.ColorIndex = 0
    .Columns(rngTarget.Column).Cells.Interior.ColorIndex = 35
    .Rows(rngTarget.Row).Cells.Interior.ColorIndex = 35
End With
End Sub
此代码不会影响复制、剪切和粘贴功能。示例文档见用颜色自动突出显示当前单元格行列3.xls。

gGztgiT9.rar (6.72 KB, 下载次数: 318)

fanjy · 发表于 2006-10-27 13:40

(4) 在工作表中有一个复选框，用来决定是否突出显示当前单元格所在的行和列。即当您选中该复选框后，将突出显示当前单元格所在的行和列。在需要设置此功能的工作表模块中输入下面的代码：
Private Sub CheckBox1_Change()
If Me.CheckBox1.Value = False Then
    Me.Cells.Interior.ColorIndex = 0
End If
End Sub
‘- - - - - - - - - - - - - - - - - - - - -
Private Sub Worksheet_Change(ByVal target As Range)
If Me.CheckBox1.Value = True Then
    If Application.CutCopyMode <> False Then
      Application.CutCopyMode = False
      Call ColorBand(target)
    End If
End If
End Sub
‘- - - - - - - - - - - - - - - - - - - - -
Private Sub Worksheet_SelectionChange(ByVal target As Range)
If Me.CheckBox1.Value = True Then
    If Application.CutCopyMode = False Then
      Call ColorBand(target)
    Else
      Exit Sub
    End If
End If
End Sub
‘- - - - - - - - - - - - - - - - - - - - -
Private Sub ColorBand(ByVal rngTarget As Range)
With rngTarget.Parent
    .Cells.Interior.ColorIndex = 0
    .Columns(rngTarget.Column).Cells.Interior.ColorIndex = 35
    .Rows(rngTarget.Row).Cells.Interior.ColorIndex = 35
End With
End Sub
示例文档见用颜色自动突出显示当前单元格行列4.xls。 ERpO59Oy.rar (8.83 KB, 下载次数: 302)

By fanjy in 2006-10-27

		自动登录	找回密码
密码			免费注册

[分享]自动为当前单元格所在行和列加上颜色

评分