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