Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2175|回复: 8

[已解决]添加语句求完美

[复制链接]
发表于 2013-2-3 22:06 | 显示全部楼层 |阅读模式
在学习中,程序如下:
Option Explicit
  Sub RngInput()
      Dim rng As Range
      On Error GoTo line
      Set rng = Application.InputBox("请使用鼠标选择单元格区域:", , , , , , , 8)
      添加语句,使下面底色灰色的只有有数据的区域里。
      rng.Interior.ColorIndex = 15
line:
End Sub
求救的意思是:
示例1
本意是读取区域A5:A11,但是,事实上很容易上下读取区域会超出,比如:A3:A15,能否在上面什么地方,添加语句,去掉上面和下面的空白区域,还是使A5:A11的底色变灰。
示例2
意思与示例1差不多,只不过是多行多列,这样的问题,在编程上考录起来会否复杂很多,我要的是这个复杂的情况也能处理的语句,麻烦你们了。
最佳答案
2013-2-3 22:16
  1. Rng.SpecialCells(xlCellTypeConstants).Interior.ColorIndex = 15
  2. Rng.SpecialCells(xlCellTypeFormulas).Interior.ColorIndex = 15
复制代码
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2013-2-3 22:13 | 显示全部楼层
  1. Sub hoogle()
  2.       Range("a5:A15").Interior.ColorIndex = 15
  3. End Sub
复制代码
回复

使用道具 举报

发表于 2013-2-3 22:14 | 显示全部楼层
回复

使用道具 举报

发表于 2013-2-3 22:16 | 显示全部楼层    本楼为最佳答案   
  1. Rng.SpecialCells(xlCellTypeConstants).Interior.ColorIndex = 15
  2. Rng.SpecialCells(xlCellTypeFormulas).Interior.ColorIndex = 15
复制代码
回复

使用道具 举报

 楼主| 发表于 2013-2-3 22:27 | 显示全部楼层
hwc2ycy ,定位或语句都不是我想要的,你介绍的定位或语句把数据与数据之间都空了(数据与数据之间的空的区域我还是要底色变灰的。)
回复

使用道具 举报

发表于 2013-2-3 22:53 | 显示全部楼层
jhtjj 发表于 2013-2-3 09:27
hwc2ycy ,定位或语句都不是我想要的,你介绍的定位或语句把数据与数据之间都空了(数据与数据之间的空的区 ...

你要的是这个效果?
  1. Sub RngInput()
  2.       Dim rng As Range
  3.       Dim TotalRows As Long, FirstRow As Long, Lastrow As Long
  4.       On Error GoTo line
  5.       Set rng = Application.InputBox("请使用鼠标选择单元格区域:", , , , , , , 8)
  6.       '添加语句,使下面底色灰色的只有有数据的区域里。
  7.       If Application.CountA(rng) = 0 Then MsgBox "所选区域全为空值": Exit Sub
  8. With rng
  9.     TotalRows = .Rows.Count
  10.         If IsEmpty(.Cells(1, 1)) Then
  11.             FirstRow = .Cells(1, 1).End(xlDown).Row       '所选区域非空第一行
  12.         Else
  13.             FirstRow = .Cells(1, 1).Row
  14.         End If
  15.         
  16.         If IsEmpty(.Cells(TotalRows, 1)) Then
  17.             Lastrow = .Cells(TotalRows, 1).End(xlUp).Row  '非空最后一行
  18.         Else
  19.             Lastrow = .Cells(TotalRows, 1).Row
  20.         End If
  21. End With
  22.       
  23.       Range(Cells(FirstRow, 1), Cells(Lastrow, 1)).Interior.ColorIndex = 15
  24. line:
  25. End Sub
复制代码

Test_A.rar

10.2 KB, 下载次数: 3

回复

使用道具 举报

 楼主| 发表于 2013-2-4 08:54 | 显示全部楼层
谢谢6楼的adders,一列的可以了,多列的还不行,我要的就是这些语句(其实,我也会一些,就是懒。),有你给的这个基础,我会调整出个正确的结果,谢谢,再次谢谢各位。
回复

使用道具 举报

发表于 2013-2-4 10:41 | 显示全部楼层
jhtjj 发表于 2013-2-4 08:54
谢谢6楼的adders,一列的可以了,多列的还不行,我要的就是这些语句(其实,我也会一些,就是懒。),有你给 ...

  1. Sub RngInput()
  2. Dim Rng As Range, Rg1 As Range, Rg2 As Range
  3. Dim Hx As Long, Lx As Long, Tf As Boolean
  4.       
  5.     Set Rng = Application.InputBox("请使用鼠标选择单元格区域:", , , , , , , 8)
  6.     If Application.CountA(Rng) = 0 Then MsgBox "所选区域全为空值": Exit Sub
  7.     With Rng
  8.         For Lx = 1 To .Columns.Count
  9.             Tf = True
  10.             If IsEmpty(Cells(1, Lx)) Then
  11.                 Set Rg1 = Cells(1, Lx).End(xlDown)
  12.                 If Rg1.Row > Cells(.Rows.Count, Lx).Row Then Tf = False
  13.             Else
  14.                 Set Rg1 = Cells(1, Lx)
  15.             End If
  16.             If IsEmpty(Cells(.Rows.Count, Lx)) Then
  17.                 Set Rg2 = Cells(.Rows.Count, Lx).End(xlUp)
  18.                 If Rg2.Row < Cells(1, Lx).Row Then Tf = False
  19.             Else
  20.                 Set Rg2 = Cells(.Rows.Count, Lx)
  21.             End If
  22.             If Tf Then Range(Rg1, Rg2).Interior.ColorIndex = 5
  23.         Next
  24.     End With
  25. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2013-2-4 13:33 | 显示全部楼层
谢谢各位的回答,还是hwc2ycy老师回答的比较贴近我的意图,6、8楼的感觉有点绕。
hwc2ycy老师作为本提问的本意不是很贴切,但是,他的思路,对我编写程序的提速有更大帮助。
本提问就不要再回答了,一并谢谢各位了。
我会以我编写的通用小工具报答大家。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 17:30 , Processed in 0.377736 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表