VBA搜索所有工作表以获得双击单元格值

时间:2016-01-25 21:39:59

标签: excel vba excel-vba events

前几天我学会了如何使用VBA双击sheet1中的单元格然后它会跳转到Sheet 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

在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

如果有人知道如何创建一个工作表循环,以便它将在每个工作表中查找值,我将非常感激!

谢谢! Emmily 我之前代码的来源:http://www.sitestory.dk/excel_vba/hyperlinks-alternative.htm

3 个答案:

答案 0 :(得分:4)

将您的第二个Sub更改为:

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

答案 1 :(得分:4)

你走了。将搜索所有工作表并在未找到任何内容时返回消息。如果找到它将激活细胞。

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

答案 2 :(得分:1)

如果您需要在整个工作簿中查找搜索词的所有实例,而不是仅仅知道至少有一次出现,您可能需要在此查看Chip Pearson的FindAll方法:< / p>

pip documentation

您可以按如下方式使用他的FindAllOnWorksheets:

{{1}}