|
楼主 |
发表于 2014-10-10 09:30
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 HAPPY_1117 于 2014-10-10 09:57 编辑
5. 综合示例
[示例1]查找值并选中该值所在的单元格
[示例1-1]
Sub Find_First()
Dim FindString As String
Dim rng As Range
FindString = InputBox("请输入要查找的值:")
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
Application.Goto rng, True
Else
MsgBox "没有找到!"
End If
End With
End If
End Sub
|
示例说明:运行程序后,将在工作表Sheet1的A列中查找InputBox函数输入框中所输入的值,并查找该值所在的第一个单元格,如果没有找到该值,则显示消息框“没有找到!”。语句Application.Goto rng, True的作用是将窗口滚动至该单元格,即该单元格位于当前窗口的左上方。
[示例1-2]
Sub Find_Last()
Dim FindString As String
Dim rng As Range
FindString = InputBox("请输入要查找的值")
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=FindString, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not rng Is Nothing Then
Application.Goto rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
|
示例说明:与上面的程序不同的是,运行该程序后,将在工作表Sheet1的A列中查找InputBox函数输入框中所输入的值,并选中该值所在的最后一个单元格。请比较代码中Find方法的参数。
[示例1-3]
Sub Find_Todays_Date()
Dim FindString As Date
Dim rng As Range
FindString = Date With Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
Application.Goto rng, True
Else
MsgBox "没有找到!"
End If
End With
End Sub
|
示例说明:运行程序后,将在工作表Sheet1的A列中查找日期所在的单元格,并选中第一个日期单元格。
[示例2]在B列中标出A列中有相应值的单元格
Sub Mark_cells_in_column()
Dim FirstAddress As String
Dim myArr As Variant
Dim rng As Range
Dim I As Long
Application.ScreenUpdating = False
myArr = Array("VBA") '也能够在数组中使用更多的值,如下所示 'myArr = Array("VBA", "VSTO")
With Sheets("Sheet2").Range("A:A")
.Offset(0, 1).ClearContents '清除右侧单元格中的内容
For I = LBound(myArr) To UBound(myArr)
Set rng = .Find(What:=myArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False) '如要想查找rng.value中的一部分,可使用参数值xlPart '如果使用LookIn:=xlValues,也会处理公式单元格中与条件相同的值
If Not rng Is Nothing Then
FirstAddress = rng.Address
Do
rng.Offset(0, 1).Value = "X" '如果值VBA找到,则在该单元格的右侧列中的相应单元格作上标记
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> FirstAddress
End If
Next I
End With
Application.ScreenUpdating = True
End Sub
|
示例说明:运行程序后,将查找工作表Sheet2上A列中的每个单元格,并在值为“VBA”所在的单元格的右侧单元格中作出标记“X”。
[示例3]为区域中指定值的单元格填充颜色
Sub Color_cells_in_Range()
Dim FirstAddress As String
Dim MySearch As Variant
Dim myColor As Variant
Dim rng As Range
Dim I As Long
MySearch = Array("VBA")
myColor = Array("3") '也能在数组中使用多个值 'MySearch = Array("VBA", "Hello", "OK") 'myColor = Array("3", "6", "10")
With Sheets("Sheet3").Range("A1:C4") '将所有单元格中的填充色改为无填充色
.Interior.ColorIndex = xlColorIndexNone
For I = LBound(MySearch) To UBound(MySearch)
Set rng = .Find(What:=MySearch(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False) '如果想查找rng.value的一部分,则使用参数值xlPart '如果使用LookIn:=xlValues,则也会处理公式单元格
If Not rng Is Nothing Then
FirstAddress = rng.Address
Do
rng.Interior.ColorIndex = myColor(I)
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> FirstAddress
End If
Next I
End With
End Sub
|
示例说明:运行程序后,将在工作表Sheet3上的单元格区域A1:C4中查找含有“VBA”的单元格,并将这些单元格填充为红色。如示例中的注释所提示的,也可以使用数组,将不同的值所在的单元格标记为不同的颜色。
也可以添加下面的语句,改变单元格中文本的颜色:
.Font.ColorIndex=0.Font.ColorIndex=myColor(I) |
[示例4]为工作表中指定值的单元格填充颜色
Sub Color_cells_in_Sheet()
Dim FirstAddress As String
Dim MySearch As Variant
Dim myColor As Variant
Dim rng As Range
Dim I As Long
MySearch = Array("VBA")
myColor = Array("3") '也能在数组中使用多个值 'MySearch = Array("VBA", "Hello", "OK") 'myColor = Array("3", "6", "10")
With Sheets("Sheet4").Cells '将所有单元格中的填充色改为无填充色
.Interior.ColorIndex = xlColorIndexNone
For I = LBound(MySearch) To UBound(MySearch)
Set rng = .Find(What:=MySearch(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False) '如果想查找rng.value的一部分,则使用参数值xlPart '如果使用LookIn:=xlValues,则也会处理公式单元格
If Not rng Is Nothing Then
FirstAddress = rng.Address
Do
rng.Interior.ColorIndex = myColor(I)
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> FirstAddress
End If
Next I
End With
End Sub
|
示例说明:运行程序后,将在工作表Sheet4中查找含有“VBA”的单元格,并将这些单元格填充为红色。如示例中的注释所提示的,也可以使用数组,将不同的值所在的单元格标记为不同的颜色。
也可以添加下面的语句,改变单元格中文本的颜色: |
|