第一个小工具(用来选择区域的四周)

良凤精品

第一次用vba  做了一个小工具,用于选择一个区域的四周,
当输入左上角的单元格和右下角的单元格,则会自动选择由这两个单元格组成的区域四周.并填充颜色.
这是excel本身不具备的功能.
花了一个小时,解决了.无比兴奋.对于高手来说比较简单,见笑了.
代码如下:
      Private Sub CommandButton1_Click()
Dim x As Range
Dim y As Range
  Worksheets("例子").Activate
Set x = Application.InputBox(prompt:="请输入左上角的单元格", Title:="这是一个测试", Type:=8)
Set y = Application.InputBox(prompt:="请输入右下角的单元格", Title:="这是一个测试", Type:=8)
Set up = Worksheets("例子").Range(x, Cells(x.Row, y.Column))
Set lf = Worksheets("例子").Range(x, Cells(y.Row, x.Column))
Set dn = Worksheets("例子").Range(Cells(y.Row, x.Column), y)
Set rt = Worksheets("例子").Range(Cells(x.Row, y.Column), y)
Union(up, lf, dn, rt).Select
Application.Selection.Interior.ColorIndex = 3
End Sub

lb_bn

支持楼主，谢谢分享。

cxffxc

不错
谢谢分享
我帮你移到“原创发表”栏目吧。

来生缘

支持。。。。

smhf_6

谢谢楼主分享：
我们换一种方式如何？（无好坏之分，只是显示结果有差异：您的两次选择均允许是2个以上的单元格，周边宽度就可能超过1个以上的单元格，我只选择一次，周边宽度就是一个单元格）
Sub gg()
Dim x As Range
Dim y As Range
Worksheets("例子").Activate
Set x = Application.InputBox(prompt:="请输入选定范围的单元格", Title:="这是一个测试", Type:=8)

Set up = x.Rows(1)
Set lf = x.Columns(1)
Set dn = x.Rows(x.Rows.Count)
Set rt = x.Columns(x.Columns.Count)
Union(up, lf, dn, rt).Select
Application.Selection.Interior.ColorIndex = 3
End Sub

良凤精品

smhf_6  设计的果然巧妙,我正想改进变成一次选择呢.
谢谢你帮我解决了.学习了.

smhf_6

原帖由 良凤精品 于 2009-11-1 11:48 发表
smhf_6  设计的果然巧妙,我正想改进变成一次选择呢.
谢谢你帮我解决了.学习了.

别夸，我倒是喜欢你的，因为你的图案具有层次感，丰富的多，我的则非常单调，

飞云楼主

谢谢楼主分享第一次