[已解决]选取多个单元格

xdwy

如题，如果B列的单元格后3位等于“Dxx”，选取同行的C列。
select选取，希望用最快的方法。

谢谢了

选取.rar (26.55 KB, 下载次数: 27)

2011-5-15 20:33 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

wbzxz

2011-5-15 20:33

我想了想，这个问题用application的union方法可能比较适合，先通过单元格循环，找到符合条件的单元格，然后用union方法联合在一起，然后整体选择；
具体代码如下：

1. 
   
2. Sub test()
   
3.   Dim i As Integer '循环计数器
   
4.   Dim rngEnd As Range '存放选中的单元格
   
5.   For i = 3 To 141 '因为不知道你的实际数据，所以这里用了死代码，从第3行到141行；
   
6.     If Right(Cells(i, 2), 3) = "Dxx" Then 'right函数取后三位进行判断，是否等于"Dxx"
   
7.       If rngEnd Is Nothing Then '因为用union方法的时候，第一次使用，必须保证union的参数是存在的，所以需要先给rngEnd赋值；
   
8.         Set rngEnd = Cells(i, 3)
   
9.       Else
   
10.         Set rngEnd = Union(rngEnd, Cells(i, 3)) '不停的用union方法进行单元格的联合
    
11.       End If
    
12.     End If
    
13.   Next i
    
14.   rngEnd.Select '选中联合在一起的单元格
    
15. End Sub
    

复制代码

附加如下：

11.rar (26.55 KB, 下载次数: 6)

2011-5-15 22:27 上传

点击文件名下载附件
为了方便，我把代码写在Sheet1中啦，呵呵。

跳转到最佳答案楼层

wbzxz

我想了想，这个问题用application的union方法可能比较适合，先通过单元格循环，找到符合条件的单元格，然后用union方法联合在一起，然后整体选择；
具体代码如下：

1. 
   
2. Sub test()
   
3.   Dim i As Integer '循环计数器
   
4.   Dim rngEnd As Range '存放选中的单元格
   
5.   For i = 3 To 141 '因为不知道你的实际数据，所以这里用了死代码，从第3行到141行；
   
6.     If Right(Cells(i, 2), 3) = "Dxx" Then 'right函数取后三位进行判断，是否等于"Dxx"
   
7.       If rngEnd Is Nothing Then '因为用union方法的时候，第一次使用，必须保证union的参数是存在的，所以需要先给rngEnd赋值；
   
8.         Set rngEnd = Cells(i, 3)
   
9.       Else
   
10.         Set rngEnd = Union(rngEnd, Cells(i, 3)) '不停的用union方法进行单元格的联合
    
11.       End If
    
12.     End If
    
13.   Next i
    
14.   rngEnd.Select '选中联合在一起的单元格
    
15. End Sub
    

复制代码

附加如下：

11.rar (26.55 KB, 下载次数: 6)

2011-5-15 22:27 上传

点击文件名下载附件
为了方便，我把代码写在Sheet1中啦，呵呵。

cjainwei

用筛选，包含"Dxx“
定位可见单元格

wbzxz

如果B列的单元格前3位等于“Dxx”

到底是后三位还是前三位，前三位根本就没有啊。

xdwy

wbzxz 发表于 2011-5-15 22:04
如果B列的单元格前3位等于“Dxx”

到底是后三位还是前三位，前三位根本就没有啊。

谢谢提醒，是后三位，请教了，谢谢

xdwy

回复 cjainwei 的帖子

需要用vba解决了，不要筛选，而是选中符合条件的单元格右移动1列

xdwy

回复 wbzxz 的帖子

代码很精彩

请教一个知识点问题union方法可极限的选取多少个单元格呢？？

非常非常的感谢

wbzxz

不好意思，这个我没有实验过，呵呵，你可以试一试，试完了告诉我一声。
不过我估计很大的，嘿嘿。

cjainwei

1. Sub t()
   
2. Dim d
   
3. Set d = CreateObject("scripting.dictionary")
   
4. For i = 3 To [b65536].End(xlUp).Row
   
5.     If InStr(Cells(i, 2), "Dxx") Then d(Cells(i, 3).Address) = ""
   
6. Next
   
7. Range(Join(d.keys, ",")).Select
   
8. End Sub

复制代码

xdwy

回复 cjainwei 的帖子

测试失败的，提示如下，盼求教