[發問] 請教如何尋找遠端磁碟中excel檔案工作表結果

chengtoo

請教各位大大:
我在工作上有一個遠端公用磁碟
要用何種方式可以讓大家都去查詢公用磁碟上某個excel檔案
進而帶出各工作表中所需要的尋找目標

chengtoo

A.rar (151.39 KB)

檔案
下載次數: 12

2013-3-14 21:55

回復 1# chengtoo

chengtoo

name.rar (15.44 KB)

下載次數: 6

2013-3-15 19:29

下面基本上可以代替我要的結果
只是想請各位大大幫忙看一下
如果我要的結果不是要以連結的顯示而是要直接秀出結果該怎麼修改

另外假設沒收尋出結果 會一直出現錯誤在 最後面的 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

GBKEE

回復 3# chengtoo
沒搜尋出結果 會一直出現錯誤在 最後面的 End If  執行後沒這錯誤
試試看 修改是你所需嗎?

1. Sub QuickSearch()
   
2.     Dim wks As Excel.Worksheet
   
3.     Dim rCell As Excel.Range
   
4.     Dim szLookupVal As String
   
5.     szLookupVal = InputBox("key in", "key in msg", "")
   
6.     If szLookupVal = "" Then Exit Sub
   
7.     Application.ScreenUpdating = False
   
8.     'Application.DisplayAlerts = False
   
9.     On Error GoTo Sheet_add        '程式碼有錯誤:GoTo(到) Sheet_add 繼續執行程式碼
   
10.     With Sheets("Result").Cells    '工作表不存在會有錯誤
    
11.         .Clear
    
12.         .Cells(1) = "下面也有所需要資訊" & szLookupVal
    
13.         .EntireColumn.AutoFit
    
14.         .HorizontalAlignment = xlCenter
    
15.     End With
    
16.     On Error GoTo 0                 '程式碼有錯誤:不處裡->預防有不知的錯誤可再修正程式碼
    
17.     i = 2
    
18.     For Each wks In ActiveWorkbook.Worksheets
    
19.         If wks.Name = "Result" Then Exit For
    
20.         With wks.Cells
    
21.             Set rCell = .Find(szLookupVal, , , xlWhole, xlByColumns, xlNext, False)
    
22.             If Not rCell Is Nothing Then
    
23.                 szFirst = rCell.Address
    
24.                 Do
    
25.                     With Sheets("Result")
    
26.                         .Cells(i, 1) = wks.Name & "'!" & rCell.Address
    
27.                         .Cells(i, 2) = rCell
    
28.                     End With
    
29.                     rCell.Interior.ColorIndex = 19
    
30.                     Set rCell = .FindNext(rCell)
    
31.                     i = i + 1
    
32.                 Loop While Not rCell Is Nothing And rCell.Address <> szFirst
    
33.             End If
    
34.         End With
    
35.     Next wks
    
36.     Set rCell = Nothing
    
37.     Sheets("Result").Activate
    
38.     If i = 2 Then MsgBox "所要查找的值{" & szLookupVal & "}在工作表中沒有", 64, "找不到喔"
    
39.     Application.ScreenUpdating = True
    
40.    ' Application.DisplayAlerts = True
    
41.    Exit Sub    '離開程序-> 不再執行  Sheet_add:下的程式碼
    
42. Sheet_add:  'Result不存在時新增工作表
    
43.     Sheets.Add ActiveSheet
    
44.     ActiveSheet.Name = "Result"
    
45.     Resume       '回到程式碼錯誤行繼續執行程式
    
46. End Sub

複製代碼

chengtoo

回復 4# GBKEE

GBKEE大大:
感謝您的協助
另外如果是最後收尋的結果沒有時我要刪除result工作表
是不是只要在最後 sheets("result").Delete  ??
因為用這樣的話都會跳出一個視窗 確認是否刪除
我想要自動刪除的話 不知該如何改

GBKEE

回復 5# chengtoo
對於不了解的VBA 函數,方法屬性 ,多看說明會進步的

1.       '.....程式碼     
   
2.      Set rCell = Nothing
   
3.     Sheets("Result").Activate
   
4.     If i = 2 Then
   
5.         Application.DisplayAlerts = False    '停止:系的統詢問視窗
   
6.         MsgBox "所要查找的值{" & szLookupVal & "}在工作表中沒有", 64, "找不到喔"
   
7.         Sheets("Result").Delete
   
8.         Application.DisplayAlerts = True   '恢復:系統的詢問視窗
   
9.     End If
   
10.     Application.ScreenUpdating = True
    
11.    '.....程式碼

複製代碼

chengtoo

回復 6# GBKEE
謝謝 GBKEE大大
我會努力學習的 感謝 已經解決