欢迎来到天天文库
浏览记录
ID:17407181
大小:1.39 MB
页数:7页
时间:2018-08-31
《excel实现鼠标用不同颜色十字定位表格》由会员上传分享,免费在线阅读,更多相关内容在学术论文-天天文库。
1、excel实现鼠标用不同颜色定位表格参考文档:http://jingyan.baidu.com/article/375c8e198cf51525f3a22966.html实现鼠标十字定位目标,效果见下图:由于长期需要用excel进行数据录入,当excel数据一多,经常由于行和列的问题会看错。为了避免这种情况。就想到用用下面的办法解决这个问题1.实现的效果就是鼠标点到那,都有一个不同的颜色区分出,鼠标所在位置的行和列2.我用的版本是office2010,打开excel,新建如下图。3.在sheet1下标签处,点击鼠标右键,出现如下图4.选择查看代码5.看到如下
2、界面,插入如下代码Code1(office2010版本可用,office2007未测试)PrivateSubWorksheet_SelectionChange(ByValTargetAsExcel.Range) OnErrorResumeNext Cells.FormatConditions.Delete iColor=39 WithTarget.EntireRow.FormatConditions .Delete .AddxlExpression,,"TRUE" .Item(1).Interior.Colo
3、rIndex=iColor EndWith WithTarget.EntireColumn.FormatConditions .Delete .AddxlExpression,,"TRUE" .Item(1).Interior.ColorIndex=iColor EndWithEndSub注:iColor=34(绿色) 38(粉色)6(黄色)iColor=39 紫色Code2(office2010版本可用,office2007未测试)该代码可实现横竖是两种不同颜色,但是原表格底色变成白色PrivateSubW
4、orksheet_SelectionChange(ByValTargetAsRange)Rows.Interior.ColorIndex=0Rows(Target.Row).Interior.ColorIndex=39Columns(Target.Column).Interior.ColorIndex=42EndSubCode3(office2010版本不可用,office2007未测试)PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfTarget.Count>1ThenExitSubIfTa
5、rget.Column>=9AndTarget.Column<=48ThenWithTarget.InteriorIf.ColorIndex=3Then.ColorIndex=xlNoneElse.ColorIndex=3.Pattern=xlSolid.PatternColorIndex=xlAutomaticEndIfEndWithEndIfIfTarget.Column>=50AndTarget.Column<=67ThenWithTarget.InteriorIf.ColorIndex=5Then.ColorIndex=xlNoneElse.Colo
6、rIndex=5.Pattern=xlSolid.PatternColorIndex=xlAutomaticEndIfEndWithEndIfEndSubCode4(office2010版本可用,office2007未测试)PrivateSubWorksheet_SelectionChange(ByValTargetAsExcel.Range)OnErrorResumeNextCells.FormatConditions.DeleteiColor=Int(50*Rnd()+2)WithTarget.EntireRow.FormatConditions.Del
7、ete.AddxlExpression,,"TRUE".Item(1).Interior.ColorIndex=iColorEndWithWithTarget.EntireColumn.FormatConditions.Delete.AddxlExpression,,"TRUE".Item(1).Interior.ColorIndex=iColorEndWithEndSubCode5(office2010版本可用,office2007未测试)PrivateSubWorksheet_SelectionChange(ByValTargetAsExcel.Rang
8、e)OnErrorResumeNextCells.F
此文档下载收益归作者所有