Select Case bTag
Case True
rCell.Interior.ColorIndex = 19
End Select
Set rCell = .FindNext(rCell)
i = i + 1
Loop While Not rCell Is Nothing And rCell.Address <> szFirst
End If
End With
Next wks
Set rCell = Nothing
If i = 2 Then
MsgBox "所要查找的值{" & szLookupVal & "}在工作表中沒有", 64, "找不到喔"
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub作者: GBKEE 時間: 2013-3-16 09:06
回復 3#chengtoo
沒搜尋出結果 會一直出現錯誤在 最後面的 End If 執行後沒這錯誤
試試看 修改是你所需嗎?
Sub QuickSearch()
Dim wks As Excel.Worksheet
Dim rCell As Excel.Range
Dim szLookupVal As String
szLookupVal = InputBox("key in", "key in msg", "")
If szLookupVal = "" Then Exit Sub
Application.ScreenUpdating = False
'Application.DisplayAlerts = False
On Error GoTo Sheet_add '程式碼有錯誤:GoTo(到) Sheet_add 繼續執行程式碼
With Sheets("Result").Cells '工作表不存在會有錯誤
.Clear
.Cells(1) = "下面也有所需要資訊" & szLookupVal
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
End With
On Error GoTo 0 '程式碼有錯誤:不處裡->預防有不知的錯誤可再修正程式碼
i = 2
For Each wks In ActiveWorkbook.Worksheets
If wks.Name = "Result" Then Exit For
With wks.Cells
Set rCell = .Find(szLookupVal, , , xlWhole, xlByColumns, xlNext, False)
If Not rCell Is Nothing Then
szFirst = rCell.Address
Do
With Sheets("Result")
.Cells(i, 1) = wks.Name & "'!" & rCell.Address
.Cells(i, 2) = rCell
End With
rCell.Interior.ColorIndex = 19
Set rCell = .FindNext(rCell)
i = i + 1
Loop While Not rCell Is Nothing And rCell.Address <> szFirst
End If
End With
Next wks
Set rCell = Nothing
Sheets("Result").Activate
If i = 2 Then MsgBox "所要查找的值{" & szLookupVal & "}在工作表中沒有", 64, "找不到喔"
