- 帖子
- 5
- 主題
- 1
- 精華
- 0
- 積分
- 18
- 點名
- 0
- 作業系統
- WIN7
- 軟體版本
- OFFICE2003
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2012-7-3
- 最後登錄
- 2023-9-14
|
3#
發表於 2013-3-15 19:29
| 只看該作者
RE: 請教如何尋找遠端磁碟中excel檔案工作表結果
 name.rar (15.44 KB)
下面基本上可以代替我要的結果
只是想請各位大大幫忙看一下
如果我要的結果不是要以連結的顯示而是要直接秀出結果該怎麼修改
另外假設沒收尋出結果 會一直出現錯誤在 最後面的 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
For Each wks In ActiveWorkbook.Worksheets
If wks.Name = "Result" Then
wks.Delete
End If
Next wks
Sheets.Add ActiveSheet
ActiveSheet.Name = "Result"
With Cells(1, 1)
.Value = "下面也有所需要資訊" & szLookupVal
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
End With
ActiveSheet.Next.Select
i = 2
For Each wks In ActiveWorkbook.Worksheets
With wks.Cells
Set rCell = .Find(szLookupVal, , , xlWhole, xlByColumns, xlNext, False)
If Not rCell Is Nothing Then
szFirst = rCell.Address
Do
rCell.Hyperlinks.Add Sheets("Result").Cells(i, 1), "", "'" & wks.Name & "'!" & rCell.Address
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 |
|
發表於 2013-3-16 09:06
| 