excel学习库

excel表格_excel函数公式大全_execl从入门到精通

Excel VBA 工作表行列高亮(再更新)/条件格式/不影响已有背景色

本文于2023年8月23日首发于本人同名公众号,更多文章案例请搜索关注!

内容提要

  • 使用条件格式,突出显示行列,保留原有背景色

  • 原代码更新,还原网格线

大家好,我是冷水泡茶,昨天我发了一篇文章【Excel VBA 工作表突出显示行列高亮(更新)/不影响已有背景色】,觉得已经“圆满”了。但是,文章下面有朋友留言:可以用条件格式。

在留言区进行了一番讨论,最后,我按这位朋友的方法试了一下,确实不错,代码简单。

还有位朋友说破坏了原来的网格线,感觉很不爽,要求来点补救代码。后来再次修改了一下代码,基本达成目的。我们一起来看一下吧::

使用条件格式

Private Sub Worksheet_SelectionChange(ByVal Target As Range)    Me.Cells.FormatConditions.Delete    With Me.Cells.FormatConditions.Add(Type:=xlExpression, Formula1:="=CELL(""row"")=ROW()")        .Interior.Color = RGB(255, 0, 0)    End With    With Me.Cells.FormatConditions.Add(Type:=xlExpression, Formula1:="=CELL(""col"")=COLUMN()")        .Interior.Color = RGB(255, 0, 0)    End WithEnd SubPrivate Sub Worksheet_Deactivate()    Me.Cells.FormatConditions.DeleteEnd SubPrivate Sub Workbook_BeforeClose(Cancel As Boolean)    Dim ws As Worksheet    For Each ws In ThisWorkbook.Worksheets        ws.Cells.FormatConditions.Delete    Next    ThisWorkbook.SaveEnd Sub

‍代码解析:

1、工作表SelectionChange事件,首先删除所有条件格式。

2、对当前工作表设置条件格式。设置条件格式而不是直接设背景色,就不会影响到单元格原来的格式了:

3、工作表Deactivate事件,删除工作表所有条件格式。

4、工作簿BeforeClose事件,删除所有工作表的条件格式,保存工作簿。

原代码修改

1、模块1,HighLight过程,高亮显示:

Public LastRange As Range ' 用于存储上次突出显示的区域Public currCell As RangePublic Dic As ObjectPublic blnHighLight As BooleanSub HighLight()    On Error Resume Next    Dim dataRange As Range    Dim currRange As Range    Dim lastRow As Long    Dim lastCol As Long    Dim rng As Range    Set Dic = CreateObject("Scripting.Dictionary")    '获取工作表的数据区域,这里假设数据区域从A1开始,向右和向下延伸    With ActiveSheet        lastRow = .UsedRange.Rows.Count        lastCol = .UsedRange.Columns.Count        Set dataRange = .Range("A1").Resize(lastRow, lastCol)        '检查选定的单元格是否在数据区域内        If Not Intersect(currCell, dataRange) Is Nothing Then            Set currRange = Union(currCell.EntireRow, currCell.EntireColumn)            Set currRange = Intersect(currRange, dataRange)        Else            lastRow = Application.WorksheetFunction.Max(lastRow, currCell.Row)            lastCol = Application.WorksheetFunction.Max(lastCol, currCell.Column)            Set dataRange = Range(Cells(1, 1), Cells(lastRow, lastCol))            Set currRange = Union(currCell.EntireRow, currCell.EntireColumn)            Set currRange = Intersect(currRange, dataRange)        End If        For Each rng In currRange            Dic(rng.Address) = rng.Interior.Color        Next        currRange.Interior.Color = RGB(245, 245, 220)        Set LastRange = currRange    End WithEnd Sub

代码解析:

(1)高亮单元格的主程序,这段应该没有改

2、其他过程:

Private Sub CmdHighLight_Click()    If Not LastRange Is Nothing Then        For Each rng In LastRange            rng.Interior.Color = Dic(rng.Address)            If rng.Interior.Color = 16777215 Then                rng.Interior.ColorIndex = xlNone            End If        Next        Set LastRange = Nothing ' 清除上次突出显示的区域        Dic.RemoveAll    End If    If blnHighLight Then        blnHighLight = False        Me.CmdHighLight.Caption = "开启高亮"    Else        blnHighLight = True        Me.CmdHighLight.Caption = "取消高亮"    End IfEnd SubPrivate Sub Worksheet_Activate()    If LastRange Is Nothing Then        Me.CmdHighLight.Caption = "开启高亮"    End IfEnd SubPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)        If blnHighLight Then        If Not LastRange Is Nothing Then            For Each rng In LastRange                rng.Interior.Color = Dic(rng.Address)                If rng.Interior.Color = 16777215 Then                    rng.Interior.ColorIndex = xlNone                End If            Next            Set LastRange = Nothing ' 清除上次突出显示的区域            Dic.RemoveAll        End If        Set currCell = Target.Cells(1, 1)        Call HighLight    Else    End IfEnd SubPrivate Sub Worksheet_Deactivate()    Dim rng As Range    If Not LastRange Is Nothing Then        For Each rng In LastRange            rng.Interior.Color = Dic(rng.Address)            If rng.Interior.Color = 16777215 Then                rng.Interior.ColorIndex = xlNone            End If        Next        Set LastRange = Nothing ' 清除上次突出显示的区域        Dic.RemoveAll    End IfEnd SubPrivate Sub Workbook_BeforeClose(Cancel As Boolean)    Dim rng As Range, ws As Worksheet, btn As OLEObject    If Not LastRange Is Nothing Then        For Each rng In LastRange            rng.Interior.Color = Dic(rng.Address)            If rng.Interior.Color = 16777215 Then                rng.Interior.ColorIndex = xlNone            End If        Next        Set LastRange = Nothing ' 清除上次突出显示的区域    End If    '在关闭工作簿前,把开启或取消高亮的命令按钮的Caption恢复成“开启高亮”    For Each ws In ThisWorkbook.Sheets        For Each btn In ws.OLEObjects            If btn.Object.Caption = "取消高亮" Then                btn.Object.Caption = "开启高亮"            End If        Next    Next    ThisWorkbook.SaveEnd Sub

代码解析:

(1)在所有的:

rng.Interior.Color = Dic(rng.Address)

下面增加3行代码,判断单元格是否是白色,是白色就把背景色设为无填充。

If rng.Interior.Color = 16777215 Then      rng.Interior.ColorIndex = xlNoneEnd If

3、注意事项:

(1)条件格式的方法,仅做了简单处理,整行整列都高亮,应该也可以设置成在数据区域范围内高亮。

(2)在条件格式的方法下,工作表不能使用其他条件格式,如果要保留原有的条件格式,那就又搞复杂了。

(3)在工作表Dactivate、工作簿BeforeClose事件中,都进行了条件格式的删除。如果不删除,就会有一个十字架显示在工作表中,感觉不太美观。

(4)在把白色单元格的填充色改为无填充后,对原本就是白色的单元格会产生影响,反正总是不能完美,顾了这头顾不了那头。

(5)在原来的方法中,命令按钮CmdHighLight,“开启高亮”、“取消高亮”,有时候也会有点小问题,不听使唤,不再管它了。

(6)两种方法都有优点,也有不足。如果从学习研究VBA的角度来说,两种方法都值得试试。

(7)就我个人而言,我仍然倾向于非条件格式的方法。原因是我对条件格式没有什么好感,以前工作表中一大堆条件格式,不仅影响工作表的性能,而且它不太稳定,看那个条件格式的规则窗口,东一段西一段的,搞得自己都晕乎;还有一个原因是,原先的代码中,运用字典来存储单元格的格式,还是有一点别出心裁的,当然,还是实用为先,各人喜欢罢了。

~~~~~~End~~~~~~

喜欢就点个、点在看留个言呗!分享一下更给力!感谢!

发表评论:

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。

«    2024年12月    »
1
2345678
9101112131415
16171819202122
23242526272829
3031
控制面板
您好,欢迎到访网站!
  查看权限
网站分类
搜索
最新留言
    文章归档
      友情链接