【VBA Find】完整教學：語法參數、5大除錯技巧與多條件搜尋實作

Set result = Range.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)

Set result = ws.Range("A1:A1000").Find( _
    What:="目標值", _
    LookIn:=xlValues, _
    LookAt:=xlWhole, _
    SearchOrder:=xlByRows, _
    MatchCase:=False _
)

Sub FindEmployeeDepartment()
    Dim ws As Worksheet
    Dim result As Range

    Set ws = ThisWorkbook.Sheets("員工名單")

    Set result = ws.Range("A2:A500").Find( _
        What:="王小明", _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        MatchCase:=False _
    )

    If Not result Is Nothing Then
        ' 找到了，取得同列 B 欄的部門
        Dim dept As String
        dept = ws.Cells(result.Row, 2).Value
        MsgBox "王小明在第 " & result.Row & " 列，部門：" & dept
        ' result.Address 會回傳 "$A$15" 這樣的絕對位址
    Else
        MsgBox "找不到王小明"
    End If
End Sub

' xlWhole：只找到 A1（完全等於「台北」）
Set result = Range("A1:A4").Find(What:="台北", LookAt:=xlWhole)
' result.Address = "$A$1"

' xlPart：找到 A1（第一個包含「台北」的儲存格）
Set result = Range("A1:A4").Find(What:="台北", LookAt:=xlPart)
' result.Address = "$A$1"
' 但 FindNext 會繼續找到 A2 和 A4

Dim result As Range
Set result = ws.Range("A:A").Find(What:="目標值", LookIn:=xlValues, LookAt:=xlWhole)

If Not result Is Nothing Then
    ' 找到了，安全地操作 result
    Debug.Print "位置：" & result.Address
    Debug.Print "列號：" & result.Row
    Debug.Print "值：" & result.Value
Else
    ' 找不到，執行替代邏輯
    MsgBox "搜尋不到指定資料，請確認搜尋條件"
End If

Sub FindAllMatches()
    Dim ws As Worksheet
    Dim c As Range
    Dim firstAddress As String
    Dim count As Long

    Set ws = ThisWorkbook.Sheets("資料表")

    Set c = ws.Range("A2:A10000").Find( _
        What:="Test", _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        MatchCase:=False _
    )

    If Not c Is Nothing Then
        firstAddress = c.Address  ' 記錄起點
        count = 0

        Do
            count = count + 1
            Debug.Print "第 " & count & " 筆：" & c.Address & " = " & c.Value

            ' 這裡可以加入你的處理邏輯
            ' 例如：ws.Cells(c.Row, 3).Value = "已處理"

            Set c = ws.Range("A2:A10000").FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress

        MsgBox "共找到 " & count & " 筆匹配資料"
    Else
        MsgBox "未找到任何匹配資料"
    End If
End Sub

Function FindAll(rng As Range, val As String) As Collection
    Dim c As Range, firstAddress As String
    Dim results As New Collection

    Set c = rng.Find(What:=val, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            results.Add c
            Set c = rng.FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If

    Set FindAll = results
End Function

Sub UseFindAll()
    Dim ws As Worksheet
    Dim matches As Collection
    Dim cell As Range

    Set ws = ThisWorkbook.Sheets("訂單資料")
    Set matches = FindAll(ws.Range("B2:B5000"), "已出貨")

    If matches.count > 0 Then
        Debug.Print "共找到 " & matches.count & " 筆「已出貨」訂單："
        For Each cell In matches
            Debug.Print "  列 " & cell.Row & "：訂單編號 " & ws.Cells(cell.Row, 1).Value
        Next cell
    Else
        Debug.Print "沒有找到「已出貨」的訂單"
    End If
End Sub

Sub FindWithMultipleConditions()
    Dim ws As Worksheet
    Dim c As Range, firstAddress As String
    Dim matchCount As Long

    Set ws = ThisWorkbook.Sheets("銷售資料")

    ' 第一條件：A 欄產品名稱包含「筆電」
    Set c = ws.Range("A2:A10000").Find( _
        What:="筆電", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

    If Not c Is Nothing Then
        firstAddress = c.Address
        matchCount = 0

        Do
            ' 第二條件：同列 C 欄金額大於 30000
            If ws.Cells(c.Row, 3).Value > 30000 Then
                matchCount = matchCount + 1
                Debug.Print "符合：列 " & c.Row & _
                    "，產品：" & c.Value & _
                    "，金額：" & ws.Cells(c.Row, 3).Value
            End If

            Set c = ws.Range("A2:A10000").FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress

        MsgBox "共 " & matchCount & " 筆符合雙條件"
    End If
End Sub

Do
    ' 用 Like 進行模糊比對：A 欄以「TW-」開頭，且 B 欄包含「急件」
    If c.Value Like "TW-*" And ws.Cells(c.Row, 2).Value Like "*急件*" Then
        ' 處理符合條件的資料
        ws.Cells(c.Row, 5).Value = "優先處理"
    End If

    Set c = ws.Range("A2:A10000").FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress

Sub FindYellowCells()
    Dim ws As Worksheet
    Dim c As Range, firstAddress As String

    Set ws = ThisWorkbook.Sheets("報表")

    ' 步驟 1：設定要搜尋的格式（黃色底色）
    Application.FindFormat.Clear  ' 先清除之前的設定
    Application.FindFormat.Interior.Color = RGB(255, 255, 0)  ' 黃色

    ' 步驟 2：執行搜尋，SearchFormat 設為 True
    Set c = ws.Range("A1:Z100").Find( _
        What:="", _
        SearchFormat:=True _
    )

    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            Debug.Print "黃色儲存格：" & c.Address & " = " & c.Value
            Set c = ws.Range("A1:Z100").FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    Else
        MsgBox "沒有找到黃色底色的儲存格"
    End If

    ' 步驟 3：重要！使用後必須清除 FindFormat
    Application.FindFormat.Clear
End Sub

' ❌ 危險寫法：沒有指定 LookIn 和 LookAt
Set result = Range("A:A").Find(What:="100")

' ✅ 安全寫法：明確指定所有關鍵參數
Set result = Range("A:A").Find( _
    What:="100", _
    LookIn:=xlValues, _
    LookAt:=xlWhole, _
    MatchCase:=False _
)

' 修正方式：搜尋前先清理資料
Dim searchVal As String
searchVal = Trim("台北")  ' 清除前後空白

' 或者改用 xlPart 部分符合來容忍空白
Set result = Range("A:A").Find( _
    What:=searchVal, _
    LookIn:=xlValues, _
    LookAt:=xlPart _
)

Dim cell As Range
For Each cell In ws.Range("A2:A" & ws.Cells(ws.Rows.count, 1).End(xlUp).Row)
    cell.Value = Trim(cell.Value)
Next cell

' 修正方式 1：確保 LookIn 使用 xlValues
Set result = Range("A:A").Find(What:=100, LookIn:=xlValues)

' 修正方式 2：將搜尋值轉為字串
Set result = Range("A:A").Find(What:=CStr(100), LookIn:=xlValues)

' 假設 A1 就是目標值
' ❌ 這樣會跳過 A1，從 A2 開始搜尋
Set result = Range("A1:A100").Find(What:="目標", After:=Range("A1"))

' ✅ 不指定 After，讓 Find 使用預設值（範圍左上角）
' 搜尋會從 A1 之後開始，最後繞回 A1
Set result = Range("A1:A100").Find(What:="目標", LookIn:=xlValues, LookAt:=xlWhole)

' ❌ 寫死範圍，資料超過 100 列就找不到
Set result = ws.Range("A1:A100").Find(What:="目標")

' ✅ 動態範圍，自動偵測最後一列
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).Row
Set result = ws.Range("A1:A" & lastRow).Find( _
    What:="目標", _
    LookIn:=xlValues, _
    LookAt:=xlWhole _
)

Sub MarkCompletedTasks()
    Dim ws As Worksheet
    Dim c As Range, firstAddress As String

    Set ws = ThisWorkbook.Sheets("專案進度")

    ' 步驟 1：用 AutoFilter 篩選 C 欄狀態為「已完成」的列
    If ws.AutoFilterMode Then ws.AutoFilterMode = False  ' 先清除既有篩選
    ws.Range("A1:E500").AutoFilter Field:=3, Criteria1:="已完成"

    ' 步驟 2：在篩選結果中，用 Find 定位 D 欄（驗收日期）為空的列
    Set c = ws.Range("D2:D500").Find( _
        What:="", _
        LookIn:=xlValues, _
        LookAt:=xlWhole _
    )

    ' 步驟 3：對找到的空白驗收日期欄填入今天日期
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            ' 只處理可見列（篩選後的結果）
            If c.EntireRow.Hidden = False Then
                c.Value = Date  ' 填入今天日期
                ws.Cells(c.Row, 5).Value = "自動填入"  ' E 欄備註
            End If
            Set c = ws.Range("D2:D500").FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If

    ' 步驟 4：清除篩選
    ws.AutoFilterMode = False

    MsgBox "已完成項目的驗收日期已自動填入"
End Sub

' 取得篩選後的可見範圍
Dim visibleRange As Range
On Error Resume Next
Set visibleRange = ws.Range("D2:D500").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not visibleRange Is Nothing Then
    ' 在可見範圍中搜尋
    Set c = visibleRange.Find(What:="", LookIn:=xlValues)
    ' ... 後續處理
End If

Sub CopyMatchingRows()
    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim c As Range, firstAddress As String
    Dim dstRow As Long

    Set wsSrc = ThisWorkbook.Sheets("原始資料")
    Set wsDst = ThisWorkbook.Sheets("篩選結果")
    dstRow = 2  ' 目標工作表從第 2 列開始貼上

    ' 先複製標題列
    wsSrc.Rows(1).Copy Destination:=wsDst.Rows(1)

    Set c = wsSrc.Range("A2:A10000").Find( _
        What:="VIP", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.EntireRow.Copy Destination:=wsDst.Rows(dstRow)
            dstRow = dstRow + 1
            Set c = wsSrc.Range("A2:A10000").FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If

    MsgBox "已複製 " & (dstRow - 2) & " 列到篩選結果工作表"
End Sub

Sub DeleteMatchingRows()
    Dim ws As Worksheet
    Dim c As Range
    Dim deleteRange As Range
    Dim firstAddress As String

    Set ws = ThisWorkbook.Sheets("資料表")

    Set c = ws.Range("B2:B10000").Find( _
        What:="已取消", LookIn:=xlValues, LookAt:=xlWhole)

    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            ' 收集所有要刪除的列，最後一次刪除（效能較好）
            If deleteRange Is Nothing Then
                Set deleteRange = c.EntireRow
            Else
                Set deleteRange = Union(deleteRange, c.EntireRow)
            End If
            Set c = ws.Range("B2:B10000").FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress

        deleteRange.Delete Shift:=xlUp
        MsgBox "已刪除所有「已取消」的資料列"
    End If
End Sub

' 找到 A 欄的產品代碼，更新 D 欄的價格
Set c = ws.Range("A2:A5000").Find(What:="PRD-001", LookIn:=xlValues, LookAt:=xlWhole)

If Not c Is Nothing Then
    ws.Cells(c.Row, 4).Value = 1299  ' 更新 D 欄價格
    ws.Cells(c.Row, 5).Value = Now   ' E 欄記錄更新時間
End If

Dim ws As Worksheet
Dim result As Range

For Each ws In ThisWorkbook.Worksheets
    Set result = ws.Cells.Find(What:="目標值", LookIn:=xlValues, LookAt:=xlWhole)
    If Not result Is Nothing Then
        MsgBox "在「" & ws.Name & "」工作表找到，位置：" & result.Address
        Exit For  ' 找到就停止，或移除此行以搜尋所有工作表
    End If
Next ws