Excel 高亮显示选择行列【不影响格式】

zjyzfn

Excel 高亮显示选择行列

        ——功能类似wps的表格的阅读模式       说明：由于网上许多类似功能的方法是使用条件格式实现，当Excel中含有背景格式时变会影响Exccel格式，故自己根据录制宏得到的代码，将攺写的功能扩展到整个工作薄。
       只需将如下代码得到相应的代码区中，并在Excel的【快速访问工具栏】或【自定义功能区】设置“高亮开关”的启动按钮即可。
       另外，此方法的功能开启时，可能会对VBA的其它操作（读写数据）有影响，但可以在需要使用其它VBA功能时将 高亮功能关闭。
相关代码如下：

1. '通用模块-----------------------------------------------------------------------
   
2. '全局变量<blockquote>Public Highlight                  '高亮对象，高亮显示选中单元格所在行、列

复制代码

zjyzfn

1. 
   
2. '通用模块-----------------------------------------------------------------------
   
3. '全局变量
   
4. Public Highlight            '高亮对象，高亮显示选中单元格所在行、列
   
5. Public H_flag As Boolean    '标记高亮显示开启状态
   
6. Public sta_flag As Boolean  '标记高亮显示开启状态2，防止事件二次触发
   
7. '
   
8. Sub auto_open()
   
9.     On Error Resume Next
   
10.     Set Highlight = New HL_SH
    
11.     Set Highlight.SHTd = Application  '注册事件
    
12. End Sub
    
13. '
    
14. Sub 选择高亮()
    
15.     If H_flag Then
    
16.         H_flag = False
    
17.     Else
    
18.         H_flag = True
    
19.     End If
    
20.     sta_flag = False
    
21. End Sub
    
22. '
    
23. '类模块
    
24. Public WithEvents SHTd As Application
    
25. Private Sub SHTd_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    
26.     Dim addr As String
    
27.     Dim ACtAddr As String
    
28.     If H_flag = False Then Exit Sub
    
29.     If sta_flag Then Exit Sub                     '防止事件二次触发
    
30.     'On Error Resume Next
    
31.     If Not (Target.EntireRow.Address(False, False) = Target.Rows.Address(False, False) _
    
32.         Or Target.EntireColumn.Address(False, False) = Target.Columns.Address(False, False)) Then
    
33.         Application.ScreenUpdating = False
    
34.         addr = Target.EntireRow.Address(False, False)
    
35.         addr = addr & "," & Target.EntireColumn.Address(False, False)
    
36.         addr = Replace(addr, "1:" & Cells.Rows.Count & ",", "")
    
37.         addr = Replace(addr, ",1:" & Cells.Rows.Count, "")
    
38.         ACAddr = ActiveCell.Address(False, False)   '记录活动单元格地址
    
39.         sta_flag = True
    
40.         Range(addr).Select
    
41.         Range(ACAddr).Activate                      '恢复单元格活动状态
    
42.         sta_flag = False
    
43.         Application.ScreenUpdating = True
    
44.     End If
    
45. End Sub
    

复制代码

zjyzfn

鉴于大家不好操作，我直接奉上我的加载文件，需要的直接下载附件，并拷贝至C:\Users\你计算机的当前用户名\AppData\Roaming\Microsoft\Excel\XLSTART 下即可，之后 打开的exlcel都载有这些代码。

zjyzfn

效果如图。

zjyzfn

1. '通用模块-----------------------------------------------------------------------
   
2. '全局变量
   
3. Public Highlight            '高亮对象，高亮显示选中单元格所在行、列
   
4. Public H_flag As Boolean    '标记高亮显示开启状态
   
5. Public sta_flag As Boolean  '标记高亮显示开启状态2，防止事件二次触发
   
6. '
   
7. Sub auto_open()
   
8.     On Error Resume Next
   
9.     Set Highlight = New HL_SH
   
10.     Set Highlight.SHTd = Application  '注册事件
    
11. End Sub
    
12. '
    
13. Sub 选择高亮()
    
14.     If H_flag Then
    
15.         H_flag = False
    
16.     Else
    
17.         H_flag = True
    
18.     End If
    
19.     sta_flag = False
    
20. End Sub
    
21. '
    
22. '类模块
    
23. Public WithEvents SHTd As Application
    
24. Private Sub SHTd_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    
25.     Dim addr As String
    
26.     Dim ACtAddr As String
    
27.     If H_flag = False Then Exit Sub
    
28.     If sta_flag Then Exit Sub                     '防止事件二次触发
    
29.     'On Error Resume Next
    
30.     If Not (Target.EntireRow.Address(False, False) = Target.Rows.Address(False, False) _
    
31.         Or Target.EntireColumn.Address(False, False) = Target.Columns.Address(False, False)) Then
    
32.         Application.ScreenUpdating = False
    
33.         addr = Target.EntireRow.Address(False, False)
    
34.         addr = addr & "," & Target.EntireColumn.Address(False, False)
    
35.         addr = Replace(addr, "1:" & Cells.Rows.Count & ",", "")
    
36.         addr = Replace(addr, ",1:" & Cells.Rows.Count, "")
    
37.         ACAddr = ActiveCell.Address(False, False)   '记录活动单元格地址
    
38.         sta_flag = True
    
39.         Range(addr).Select
    
40.         Range(ACAddr).Activate                      '恢复单元格活动状态
    
41.         sta_flag = False
    
42.         Application.ScreenUpdating = True
    
43.     End If
    
44. End Sub

复制代码

zjyzfn

代码块有问题，上面发了3份一样的，[code ]\ [ code ]”标签必须独占一行，否则保存后放进的代码就只有前面一行。

aman1516

试试，是否达到需要的效果：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Cells.FormatConditions.Delete
With ActiveCell.EntireRow.FormatConditions
     .Add xlExpression, , "TRUE"
     .Item(1).Interior.ColorIndex = 34
End With
With ActiveCell.EntireColumn.FormatConditions
     .Delete
     .Add xlExpression, , "TRUE"
     .Item(1).Interior.ColorIndex = 34
End With
End Sub

aman1516

嗯，楼主的是多行多列的，学习一下

we8654219

高，实在是高！！！秒杀其他高亮代码！！！非常好用！！！

高度保密

zjyzfn 发表于 2017-9-30 16:16

这句：
Set Highlight = New HL_SH
显示用户定义类型未定义是为什么呢？

sunny_8848

多谢分享，有空尝试一下