VBAsearch所有表单以获得双击的单元格值

有一天，我学会了如何使用VBA双击sheet1中的一个单元格，然后它将跳转到表单2中的单元格。

我现在有一个类似的报告，除了这次我需要双击Sheet1中的一个单元格，然后在同一个工作簿中search每个工作表的值。

我有第一个场景的代码在这里：在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 

在Module1中：

 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 

如果有人知道如何创build一个工作表循环，以便它会查找每个工作表中的值，我将非常感激！

谢谢！ Emmily我的来源为以前的代码： http : //www.sitestory.dk/excel_vba/hyperlinks-alternative.htm

Answer 1

干得好。 如果没有find，将search所有表单并返回消息。 如果发现它将激活单元格。

 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循环遍历工作簿中的所有工作表。

有关每个循环的更多信息，请参阅这里 。

Answer 3

如果您需要在整个工作簿中查找search词的所有实例，而不必知道至less有一个发生，那么您可能需要查看Chip Pearson的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