請羅列“四川省”、“湖南省”、“湖北省”三個省份員工的資料。
VBA代碼如下：
Sub test()
‘定義變量
Dim rng As Range, RngTemp As Range, firstAddress As String
Dim i As Byte, findCell As Range, sh As Worksheet, shtname As String
‘將查找的目標設置為C2單元格到C列最后一個非空單元格賦予變量為rng
Set rng = Range([C2], Cells(Rows.Count, "C").End(xlUp))
‘循環賦予查找數組的每一個元素
For i = 0 To UBound(Array("四川省", "湖南省", "湖北省"))
‘開始查找數據，按值精確查找，不區分大小寫
Set RngTemp = rng.Find(What:=Array("四川省", "湖南省", "湖北省")(i), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
‘ 如果找到目標，則賦予該目標的單元格地址給firstAddress
If Not RngTemp Is Nothing Then
firstAddress = RngTemp.Address
Do
‘變量findCell沒有初始化，則需要初始化，否則合并查找到的數值
If findCell Is Nothing Then
Set findCell = RngTemp
Else
Set findCell = Union(findCell, RngTemp)
End If
‘查找下一個
Set RngTemp = rng.FindNext(RngTemp)
‘循環到不為第一個找到的目標地址為止
Loop While RngTemp.Address <> firstAddress
End If
Next i
‘如果查找的內容不為空，則選擇查找到內容所在行，否則顯示提醒
If Not findCell Is Nothing Then
findCell.EntireRow.Select
Else
MsgBox "沒有找到符合條件的數據!"
Exit Sub
End If
‘防止錯誤
On Error Resume Next
‘把當前工作表的名稱賦予shtname
shtname = ActiveSheet.Name
Set sht = Sheets("查詢結果")
‘如果不存在查詢結果表，則添加一個“查詢結果”工作表
If Err.Number <> 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "查詢結果"
Else
Sheets(Sheets.Count).Cells.Clear
End If
Sheets(shtname).Select
Selection.Copy Sheets(Sheets.Count).[A1]
End Sub
