Find与 Set Range 组合应用。

ningyong58

数组源
A        B
aa        11
bb        12
aa        13
cc        14
aa        15
dd        16
ee        17
ff        18
aa        19

用find函数 .Find("aa", , , xlWhole)
Set rr 得到的Range结果如下
aa        13
aa        15
aa        19

lb_bn

可以用字典或ADO
用find可用after参数或findnext

ningyong58

原帖由 lb_bn 于 2009-10-22 14:48 发表
可以用字典或ADO
用find可用after参数或findnext

目标需求不连续的Range

lb_bn

建议楼主上传附件。
示意想要得到的结果。

ningyong58

在A列中，满足aa的结果生成一个oRange
for eache ss in oRange

blazetwf

如果数据多，用字典最快，不过一般用find确定行数，然后用UNION(rr, Rows(i)) 就可以了啊

ningyong58

Sub 文本定位()
  Dim aa As Range
  Set rr = Range("A1:A9")

  For Each ss In rr
    Debug.Print ss
  Next

  For Each a In rr
    If a Like "*tt*" Then
      If aa Is Nothing Then
        Set aa = a.Cells
      Else
        Set aa = Union(aa, a.Cells)
      End If
    End If
  Next
  aa.EntireRow.Select
End Sub
http://club.excelhome.net/thread-191495-1-1.html
Book2.rar (9.89 KB, 下载次数: 4)

2009-10-22 16:03 上传

点击文件名下载附件

[ 本帖最后由 ningyong58 于 2009-10-22 16:03 编辑 ]

blazetwf

仿照FIND的HELP文档写的。

Dim rng As Range, i As Long, r As Long
Sub test()
With ActiveSheet.Range("A:A")
Set rr = .Find("aa")
If Not rr Is Nothing Then
    firstAddress = rr.Address
        Do
            If rng Is Nothing Then
            Set rng = Range("A" & rr.Row & ":" & "B" & rr.Row)
            Else: Set rng = Union(rng, Range("A" & rr.Row & ":" & "B" & rr.Row))
            End If
            Set rr = .FindNext(rr)
        Loop While Not rr Is Nothing And rr.Address <> firstAddress
rng.Copy [e11]
End If
End With
End Sub

ningyong58

原帖由 blazetwf 于 2009-10-22 15:53 发表
仿照FIND的HELP文档写的。

Dim rng As Range, i As Long, r As Long
Sub test()
With ActiveSheet.Range("A:A")
Set rr = .Find("aa")
If Not rr Is Nothing Then
    firstAddress = rr.Address
        D ...

谢谢，回复
rng.Copy [e11] --[e11]是什么意思。

Dim rng As Range, i As Long, r As Long

Sub test()

With ActiveSheet.Range("A:A")

Set rr = .Find("aa")

If Not rr Is Nothing Then
    firstAddress = rr.Address
        Do
            If rng Is Nothing Then
            Set rng = Range("A" & rr.Row & ":" & "B" & rr.Row)
            Else: Set rng = Union(rng, Range("A" & rr.Row & ":" & "B" & rr.Row))
            End If
            Set rr = .FindNext(rr)
        Loop While Not rr Is Nothing And rr.Address <> firstAddress

rng.Copy [e11]
For Each rrr In rng
  rrr.Interior.ColorIndex = 34
Next

End If
End With

End Sub

  rrr.Interior.ColorIndex = 34
只能用循环变色吗？？

blazetwf

不用循环啊，直接在LOOP 下面那行加上
rng.Interior.ColorIndex = 34

rng.copy [e11]就是把刚才UNION了的RANGE复制到E11单元格。。。如果你不想复制单元格样式，可以这样
rng.Interior.ColorIndex = 34
rng.Copy
[e11].PasteSpecial Paste:=xlPasteValues