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