VBA搜索所有工作表雙單擊的單元格值

Question

有一天，我學會了如何使用VBA雙擊在Sheet1中單元格，然後它會跳轉到細胞具有相同的值在表2

我有一個類似的報告現在，除了這次我需要雙擊Sheet1中的一個單元格，然後搜索同一工作簿中的每個工作表以獲取該值。

我有，工程的第一個場景中的代碼是在這裏： 在的ThisWorkbook：

Private Sub Workbook_SheetBeforeDoubleClick _ 
(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 

If Len(Target.Value) = 0 Then Exit Sub 

'If the double-clicked cell isn't in column A, we exit. 
If Target.Column <> 1 Then Exit Sub 

'Calls the procedure FindName in Module1 and passes the cell content 
Module1.FindName Target.Value 

End Sub 

在模塊1：

Sub FindName(ByVal sName As String) 
'Finds and activates the first cell 
'with the same content as the double-clicked cell. sName 
'is the passed cell content. 
Dim rColumn As Range 
Dim rFind As Range 

'Activate the sheet Contact Data. 
Worksheets("All Data").Activate 

'Set the range rColumn = column B 
Set rColumn = Columns("B:B") 

'Search column B 
Set rFind = rColumn.Find(sName) 

'If found the cell is activated. 
If Not rFind Is Nothing Then 
    rFind.Activate 
Else 
    'If not found activate cell A1 
    Range("A1").Activate 
End If 

Set rColumn = Nothing 
Set rFind = Nothing 

End Sub 

如果有人知道如何也許在此創建工作表圈所以它會在每個工作表中尋找價值，我會很感激！

謝謝！ Emmily 我對以前的代碼來源：http://www.sitestory.dk/excel_vba/hyperlinks-alternative.htm

Answer 1

你在這裏。如果找不到任何內容，將搜索所有工作表並返回消息。如果發現它將激活單元格。

Sub FindName(ByVal sName As String) 

    'Finds and activates the first cell in any sheet (moving left-to-right) 
    'with the same content as the double-clicked cell. sName 
    'is the passed cell content. 
    Dim rFind As Range 
    Dim ws As Worksheet 

    For Each ws In ThisWorkbook.Worksheets 

     Set rFind = ws.Columns(2).Find(sName, lookat:=xlWhole) ' look for entire match, set to xlPart to search part of cell ... 2 is column B. 

     If Not rFind Is Nothing Then 
      Dim bFound As Boolean 
      bFound = True 
      ws.Activate 
      rFind.Select 
      Exit For 
     End If 

    Next 

    If Not bFound Then MsgBox sName & " not found in any sheet." 

End Sub 

Answer 2

你的第二次更改爲：

Sub FindName(ByVal sName As String) 
'Finds and activates the first cell 
'with the same content as the double-clicked cell. sName 
'is the passed cell content. 
Dim rColumn As Range 
Dim rFind As Range 
Dim ws As Worksheet 

'Activate the sheet Contact Data. 
For Each ws In ActiveWorkbook.Worksheets 
    'Change the "Sheet1" reference to the sheet calling so it is excluded 
    If ws.Name <> "Sheet1" Then 
     'Set the range rColumn = column B 
     Set rColumn = ws.Columns("B:B") 

     'Search column B 
     Set rFind = rColumn.Find(sName) 

     'If found the cell is activated. 
     If Not rFind Is Nothing Then 
      ws.activate 
      rFind.select 
     End If 
    End If 
Next ws 
Set rColumn = Nothing 
Set rFind = Nothing 

End Sub 

這將使用For Each循環以循環工作簿中的所有表。

有關每個循環的更多信息，請參閱HERE。

Answer 3

如果你需要找到在整個工作簿搜索詞的所有實例，而不是僅僅有知道至少有一個次數，你可能想看看這裏芯片皮爾森的FindAll方法：

http://www.cpearson.com/excel/findall.aspx

你可以利用他的FindAllOnWorksheets如下：

Sub FindMyResults(ByVal sName as string) 
    Dim Result as Variant 
    Dim ResultRange as Range 
    Dim N as Long 

    Result = FindAllOnWorksheets(InWorkbook:=ThisWorkbook, _ 
     InWorksheets:="Sheet1:Sheet3", _ 
     SearchAddress:="$B:$B", _ 
     FindWhat:=sName, _ 
     LookIn:=xlValues, _ 
     LookAt:=xlWhole, _ 
     SearchOrder:=xlByRows, _ 
     MatchCase:=False) 

    For N = LBound(Result) To UBound(Result) 
     If Not Result(N) Is Nothing Then 'There is at least one result 
      For Each ResultRange In Result(N).Cells 

       'Do something with your results. 

      Next ResultRange 
     End If 
    Next N 

End Sub