- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 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, "找不到喔"
- Application.ScreenUpdating = True
- ' Application.DisplayAlerts = True
- Exit Sub '離開程序-> 不再執行 Sheet_add:下的程式碼
- Sheet_add: 'Result不存在時新增工作表
- Sheets.Add ActiveSheet
- ActiveSheet.Name = "Result"
- Resume '回到程式碼錯誤行繼續執行程式
- End Sub
|
|
發表於 2013-3-16 09:06
| 