快来看，最理想的高亮方法，不用任何插件，感谢huang1314wei 的鼎力相助！

shishui

不知道我这是不是奇葩的想法，如果有这种代码，那作用就太大了，好期待呀！！
在得到8楼huang1314wei帮助后，做了如下更新说明
附件中的高亮代码，目前最好：不改变任何格式（底色填充，字体等等），可以正常使用复制和粘贴，唯一的缺陷就是没有“撤销”，不过在所有的类似高亮的代码中，都没有“撤销”的功能，应该是VBA的运行机制不同所致

huang1314wei

这个很简单，你上传一个附件我帮你写，另外把你所谓的另一个工作表对象也一并发上来，如果你自觉能力强，我给你个样板
http://club.excelhome.net/forum. ... ead&tid=1235871

shishui

huang1314wei 发表于 2015-10-18 16:57
这个很简单，你上传一个附件我帮你写，另外把你所谓的另一个工作表对象也一并发上来，如果你自觉能力强，我 ...

自学能力倒是不差，可是刚接触VBA还不长，看不懂呀，大神，好事做到底，帮忙我打个版吧

跪谢求助.rar (16.97 KB, 下载次数: 16)

2015-10-18 17:31 上传

点击文件名下载附件

huang1314wei

shishui 发表于 2015-10-18 17:31
自学能力倒是不差，可是刚接触VBA还不长，看不懂呀，大神，好事做到底，帮忙我打个版吧

不好意思楼主，我的电脑里面没有你那个石水百宝箱的自定义工具栏，所以，没有你那个高亮行，取消高亮的玩意的，只能给你做两个按钮的，代码晚上发，现在没时间写

huang1314wei

1. Sub 复制() 'sheet1中的代码复制到激活工作表中的工作表对象中
   
2.     Dim wb As Workbook, vb1, vb2, str$
   
3.     Application.ScreenUpdating = False
   
4.     For Each wb In Workbooks
   
5.         If wb.Name <> ThisWorkbook.Name Then wb.Close True
   
6.     Next
   
7.     Set wb = Workbooks.Open(ThisWorkbook.Path & "\测试.xlsm")
   
8.     Set vb1 = wb.VBProject.VBComponents("Sheet1")
   
9.     Set vb2 = ThisWorkbook.VBProject.VBComponents("Sheet1")
   
10.     str = vb2.CodeModule.Lines(1, vb2.CodeModule.CountOfLines)
    
11.     vb1.CodeModule.DeleteLines 1, vb1.CodeModule.CountOfLines
    
12.     vb1.CodeModule.AddFromString str
    
13.     Workbooks("动态高亮.xlsm").Close False
    
14.     Application.ScreenUpdating = True
    
15.     '复制完之后，关闭这个工作表
    
16. End Sub

复制代码

1. Sub 删除() '将激活工作表中的工作表对象中的代码删除
   
2.     Dim wb As Workbook
   
3.     Application.ScreenUpdating = False
   
4.     For Each wb In Workbooks
   
5.         If wb.Name <> ThisWorkbook.Name Then wb.Close True
   
6.     Next
   
7.     Set wb = Workbooks.Open(ThisWorkbook.Path & "\测试.xlsm")
   
8.     With wb.VBProject.VBComponents("Sheet1")
   
9.         .CodeModule.DeleteLines 1, .CodeModule.CountOfLines
   
10.     End With
    
11.     wb.Sheets(1).Cells.FormatConditions.Delete
    
12.     Workbooks("动态高亮.xlsm").Close SaveChanges:=False
    
13.     Application.ScreenUpdating = False
    
14.     '删除之后，关闭这个工作表
    
15. End Sub

复制代码

huang1314wei

附件参考：

复制删除其它工作簿中的代码.rar (25.01 KB, 下载次数: 55)

2015-10-18 20:57 上传

点击文件名下载附件

shishui

huang1314wei 发表于 2015-10-18 20:57

    大神呀，基本上已经实现了我要的功能，可是有一个致命的问题，我需要应用到任何打开的工作簿，而不是仅仅是“测试”工作簿，可以是任意打开的工作簿，所以这句Set wb = Workbooks.Open(ThisWorkbook.Path & "\测试.xlsm")怎么改呢，对于任意打开的工作簿的任意工作表都能执行复制    另外，代码

• Set vb1 = wb.VBProject.VBComponents("Sheet1")
•     Set vb2 = ThisWorkbook.VBProject.VBComponents("Sheet1")
  

，只能复制到sheet1工作表，其他工作表复制不了，需要复制到当前激活的工作表，并非固定sheet1，也需要改一下！
谢了，超牛大神！！！O(∩_∩)O~

huang1314wei

1. Sub 复制() 'sheet1中的代码复制到激活工作表中的工作表对象中
   
2.     Dim wb As Workbook, vb1, vb2, str$
   
3.     Application.ScreenUpdating = False
   
4.     For Each wb In Workbooks
   
5.         If wb.Name <> ThisWorkbook.Name Then
   
6.             Set vb2 = ThisWorkbook.VBProject.VBComponents("Sheet1")
   
7.             str = vb2.CodeModule.Lines(1, vb2.CodeModule.CountOfLines)
   
8.             For Each vb1 In wb.VBProject.VBComponents
   
9.                If vb1.Name Like "Sheet*" Then
   
10.                  vb1.CodeModule.DeleteLines 1, vb1.CodeModule.CountOfLines
    
11.                  vb1.CodeModule.AddFromString str
    
12.                End If
    
13.             Next
    
14.         End If
    
15.     Next
    
16.     Workbooks("动态高亮.xlsm").Close False
    
17.     Application.ScreenUpdating = True
    
18.     '复制完之后，关闭这个工作表
    
19. End Sub
    
20. Sub 删除() '将激活工作表中的工作表对象中的代码删除
    
21.     Dim wb As Workbook, sht As Worksheet
    
22.     Application.ScreenUpdating = False
    
23.     For Each wb In Workbooks
    
24.         If wb.Name <> ThisWorkbook.Name Then
    
25.             For Each vb In wb.VBProject.VBComponents
    
26.               If vb.Name Like "Sheet*" Then vb.CodeModule.DeleteLines 1, vb.CodeModule.CountOfLines
    
27.             Next
    
28.             For Each sht In wb.Worksheets
    
29.               sht.Cells.FormatConditions.Delete
    
30.             Next
    
31.         End If
    
32.     Next
    
33.     Workbooks("动态高亮.xlsm").Close SaveChanges:=False
    
34.     Application.ScreenUpdating = False
    
35.     '删除之后，关闭这个工作表
    
36. End Sub

复制代码

huang1314wei

附件已更正

复制删除其它工作簿中的代码修改2.rar (30.5 KB, 下载次数: 67)

2015-10-19 08:51 上传

点击文件名下载附件

shishui

huang1314wei 发表于 2015-10-19 08:51
附件已更正

为了完美的高亮，我已经折磨了好多天了{:soso_e135:}，终于搞定了，虽然还不够完美，没有“撤销”功能，但已经是最优的方案了，要想加载宏，还能继续使用撤销，可能是个实现不了的空想，也不知道巨硬是怎么想的，VBA运行的为什么就不能撤销，难道不是运行在内存中吗，搞不懂！
huang1314wei 你太神了，我问了不少人，都没搞定，到你这却变成小菜了，佩服得五体投地呀{:soso_e185:}{:soso_e183:}

我已经把代码放到了自定义工具栏，打开任何工作簿，点击“高亮行列”，直接跟随鼠标高亮行列，不需要高亮了，再点击取消高亮，灰常强大，我想这个功能，好多学友都很需要，那么就来此地拿去吧，感谢huang1314wei 哟{:soso_e128:}