ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 7286|回复: 23

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

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-9-30 15:59 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 zjyzfn 于 2017-9-30 16:07 编辑

Excel 高亮显示选择行列

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

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




TA的精华主题

TA的得分主题

 楼主| 发表于 2017-9-30 16:07 | 显示全部楼层

本帖最后由 zjyzfn 于 2017-9-30 16:18 编辑

  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
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-1-25 18:37 | 显示全部楼层
鉴于大家不好操作,我直接奉上我的加载文件,需要的直接下载附件,并拷贝至C:\Users\你计算机的当前用户名\AppData\Roaming\Microsoft\Excel\XLSTART 下即可,之后 打开的exlcel都载有这些代码。

book.zip

52.36 KB, 下载次数: 313

Excel加载项文件

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-9-30 16:10 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

效果

本帖最后由 zjyzfn 于 2017-9-30 16:47 编辑

效果如图。

效果

效果

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-9-30 16:16 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
  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
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-9-30 16:20 | 显示全部楼层
代码块有问题,上面发了3份一样的,[code ]\ [ code ]”标签必须独占一行,否则保存后放进的代码就只有前面一行。

TA的精华主题

TA的得分主题

发表于 2017-10-1 20:46 | 显示全部楼层
试试,是否达到需要的效果:
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

评分

3

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-10-1 20:48 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-1-11 20:49 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
高,实在是高!!!秒杀其他高亮代码!!!非常好用!!!

TA的精华主题

TA的得分主题

发表于 2018-1-13 22:25 | 显示全部楼层

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

TA的精华主题

TA的得分主题

发表于 2018-1-14 03:13 来自手机 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 16:00 , Processed in 0.045807 second(s), 12 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表