ExcelHome技术论坛

 找回密码
 免费注册
QQ登录 只需一步,快速开始
   
高效办公必会的Office99uu优优 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! 国内首部Excel函数公式学习大典 职场充电黑科技, Office微99uu优优 免费下载Excel行业应用视频
300集Office 2010微99uu优优 Tableau-数据可视化工具 突破Excel限制,用活字格提高效率 12门Excel免费公开课任你学
你的Excel 201099uu优优学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 261|回复: 9
打印 上一主题 下一主题

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

[复制链接]
TA的精华主题TA的得分主题
跳转到指定楼层
1
发表于 2017-9-30 15:59 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式
本帖最后由 zjyzfn 于 2017-9-30 16:07 编辑

Excel 高亮显示选择行列

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

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




    分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
    收藏收藏1 分享分享 有用有用 无用无用
    TA的精华主题TA的得分主题
    来自 2楼
     楼主| 发表于 2017-9-30 16:07 | 只看该作者 |楼主

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

  • '通用模块-----------------------------------------------------------------------
  • '全局变量
  • Public Highlight            '高亮对象,高亮显示选中单元格所在行、列
  • Public H_flag As Boolean    '标记高亮显示开启状态
  • Public sta_flag As Boolean  '标记高亮显示开启状态2,防止事件二次触发
  • '
  • Sub auto_open()
  •     On Error Resume Next
  •     Set Highlight = New HL_SH
  •     Set Highlight.SHTd = Application  '注册事件
  • End Sub
  • '
  • Sub 选择高亮()
  •     If H_flag Then
  •         H_flag = False
  •     Else
  •         H_flag = True
  •     End If
  •     sta_flag = False
  • End Sub
  • '
  • '类模块
  • Public WithEvents SHTd As Application
  • Private Sub SHTd_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  •     Dim addr As String
  •     Dim ACtAddr As String
  •     If H_flag = False Then Exit Sub
  •     If sta_flag Then Exit Sub                     '防止事件二次触发
  •     'On Error Resume Next
  •     If Not (Target.EntireRow.Address(False, False) = Target.Rows.Address(False, False) _
  •         Or Target.EntireColumn.Address(False, False) = Target.Columns.Address(False, False)) Then
  •         Application.ScreenUpdating = False
  •         addr = Target.EntireRow.Address(False, False)
  •         addr = addr & "," & Target.EntireColumn.Address(False, False)
  •         addr = Replace(addr, "1:" & Cells.Rows.Count & ",", "")
  •         addr = Replace(addr, ",1:" & Cells.Rows.Count, "")
  •         ACAddr = ActiveCell.Address(False, False)   '记录活动单元格地址
  •         sta_flag = True
  •         Range(addr).Select
  •         Range(ACAddr).Activate                      '恢复单元格活动状态
  •         sta_flag = False
  •         Application.ScreenUpdating = True
  •     End If
  • End Sub
  • 复制代码

    TA的精华主题TA的得分主题
    3
     楼主| 发表于 2017-9-30 16:10 | 只看该作者 |楼主

    效果

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

    效果如图。
    TIM图片20170930164522.png (39.42 KB, 下载次数: 0) 效果
    效果
    TA的精华主题TA的得分主题
    4
     楼主| 发表于 2017-9-30 16:16 | 只看该作者 |楼主
  • '通用模块-----------------------------------------------------------------------
  • '全局变量
  • Public Highlight            '高亮对象,高亮显示选中单元格所在行、列
  • Public H_flag As Boolean    '标记高亮显示开启状态
  • Public sta_flag As Boolean  '标记高亮显示开启状态2,防止事件二次触发
  • '
  • Sub auto_open()
  •     On Error Resume Next
  •     Set Highlight = New HL_SH
  •     Set Highlight.SHTd = Application  '注册事件
  • End Sub
  • '
  • Sub 选择高亮()
  •     If H_flag Then
  •         H_flag = False
  •     Else
  •         H_flag = True
  •     End If
  •     sta_flag = False
  • End Sub
  • '
  • '类模块
  • Public WithEvents SHTd As Application
  • Private Sub SHTd_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  •     Dim addr As String
  •     Dim ACtAddr As String
  •     If H_flag = False Then Exit Sub
  •     If sta_flag Then Exit Sub                     '防止事件二次触发
  •     'On Error Resume Next
  •     If Not (Target.EntireRow.Address(False, False) = Target.Rows.Address(False, False) _
  •         Or Target.EntireColumn.Address(False, False) = Target.Columns.Address(False, False)) Then
  •         Application.ScreenUpdating = False
  •         addr = Target.EntireRow.Address(False, False)
  •         addr = addr & "," & Target.EntireColumn.Address(False, False)
  •         addr = Replace(addr, "1:" & Cells.Rows.Count & ",", "")
  •         addr = Replace(addr, ",1:" & Cells.Rows.Count, "")
  •         ACAddr = ActiveCell.Address(False, False)   '记录活动单元格地址
  •         sta_flag = True
  •         Range(addr).Select
  •         Range(ACAddr).Activate                      '恢复单元格活动状态
  •         sta_flag = False
  •         Application.ScreenUpdating = True
  •     End If
  • End Sub
  • 复制代码
    TA的精华主题TA的得分主题
    5
     楼主| 发表于 2017-9-30 16:20 | 只看该作者 |楼主
    代码块有问题,上面发了3份一样的,[code ]\ [ code ]”标签必须独占一行,否则保存后放进的代码就只有前面一行。
    TA的精华主题TA的得分主题
    6
    发表于 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
    TA的精华主题TA的得分主题
    7
    发表于 2017-10-1 20:48 | 只看该作者
    TA的精华主题TA的得分主题
    8
    发表于 2018-1-11 20:49 | 只看该作者
    高,实在是高!!!秒杀其他高亮代码!!!非常好用!!!
    TA的精华主题TA的得分主题
    9
    发表于 2018-1-13 22:25 | 只看该作者
    TA的精华主题TA的得分主题
    10
    发表于 2018-1-14 03:13 来自手机 | 只看该作者
    您需要登录后才可以回帖 登录 | 免费注册
    本版积分规则
    关闭

    最新热点上一条 /1 下一条

    关注官方微信,每天坐享新鲜教程
    手机版|关于我们|联系我们|ExcelHome    GMT+8, 2018-1-18 19:43 , Processed in 0.124266 second(s), 13 queries , Gzip On, MemCache On.
    Powered by Discuz! X3.3 © 2001-2017 Wooffice Inc.
        沪公网安备 31011702000001号 沪ICP备11019229号 本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师
    快速回复 返回顶部 返回列表
    99uu优优