|
非常有用的一个函数,转自国外网站,作用:将含有查找目标数据的单元格并为一个RANGE(类似于按住CTRL选多个区域),然后在VBA中直接对这个RANGE进行操作。
Function Find_Range(Find_Item As Variant, _
Search_Range As Range, _
Optional LookIn As Variant, _
Optional LookAt As Variant, _
Optional MatchCase As Boolean) As Range
Dim firstAddress As String
Dim c As Range
If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole
If IsMissing(MatchCase) Then MatchCase = False
With Search_Range
Set c = .Find( _
What:=Find_Item, _
LookIn:=LookIn, _
LookAt:=LookAt, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=MatchCase, _
SearchFormat:=False)
If Not c Is Nothing Then
Set Find_Range = c
firstAddress = c.Address
Do
Set Find_Range = Union(Find_Range, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Function
用法示例
'Here 's just a few of the potential uses for this function...
'Select all cells in a range that contain 22 as part of the value:
Find_Range(22, Range("D10:G20")).Select
'Clear the range if the cell contains exactly 999, but if it's a formula leave it be:
Find_Range(999, Range("D10:G20"), xlFormulas, xlWhole).ClearContents
'Delete all rows that contain "X" in column A:
Find_Range("X", Columns("A"), MatchCase:=True).EntireRow.Delete
'Quickly scan the whole sheet if you like!
Find_Range(1000, Cells, xlFormulas, xlWhole).EntireRow.Select
'Copy all the rows that have the value 1000 in column D and paste to Sheet2:
Find_Range(1000, Columns("D"), xlFormulas, xlWhole).EntireRow.Copy Range("Sheet2!A1") |
|