Excel查找基于名称的工作表

Question

Public Sub Find_Tab_Search()
    Dim sSearch As String
    sSearch = ""
    sSearch = InputBox("Enter Search", "Find Tab")
    If Trim(sSearch) = "" Then Exit Sub
    'MsgBox (sSearch)

    Dim sSheets() As String
    Dim sMatchMessage As String
    Dim iWorksheets As Integer
    Dim iCounter As Integer
    Dim iMatches As Integer
    Dim iMatch As Integer
    Dim sGet As String
    Dim sPrompt As String

    iMatch = -1
    iMatches = 0
    sMatchMessage = ""

    iWorksheets = Application.ActiveWorkbook.Sheets.Count
    ReDim sSheets(iWorksheets)

    'Put list of names in array
    For iCounter = 1 To iWorksheets
        sSheets(iCounter) = Application.ActiveWorkbook.Sheets(iCounter).Name
        If InStr(1, sSheets(iCounter), sSearch, vbTextCompare) > 0 Then
            iMatches = iMatches + 1
            If iMatch = -1 Then iMatch = iCounter
            sMatchMessage = sMatchMessage + CStr(iCounter) + ": " + sSheets(iCounter) + vbCrLf
        End If
    Next iCounter

    Select Case iMatches
        Case 0
            'No Matches
            MsgBox "No Match Found for " + sSearch
        Case 1
            '1 match activate the sheet
            Application.ActiveWorkbook.Sheets(iMatch).Activate
        Case Else
            'More than 1 match. Ask them which sheet to go to
            sGet = -1
            sPrompt = "More than one match found. Please enter number from following list"
            sPrompt = sPrompt + "to display the sheet" + vbCrLf + vbCrLf + sMatchMessage
            sPrompt = sPrompt + vbCrLf + vbCrLf + "Enter blank to cancel"
            sGet = InputBox(sPrompt, "Please select one")
            If Trim(sGet) = "" Then Exit Sub
            sPrompt = "Value must be a number" + vbCrLf + vbCrLf + sPrompt
            Do While IsNumeric(sGet) = False
                sGet = InputBox(sPrompt, "Please select one")
                If Trim(sGet) = "" Then Exit Sub
            Loop
            iMatch = CInt(sGet)
            Application.ActiveWorkbook.Sheets(iMatch).Activate
    End Select

End Sub

Answer 1

为了好玩，我尝试用尽可能少的循环行来实现这一点

在Utilizedfilter下使用范围名称、xlm和VBS，以提供与上面相同的多页搜索功能。

代码的大部分涉及纸张选择部分

Sub GetNAmes()
Dim strIn As String
Dim X

strIn = Application.InputBox("Search string", "Enter string to find", ActiveSheet.Name, , , , , 2)
If strIn = "False" Then Exit Sub

ActiveWorkbook.Names.Add "shtNames", "=RIGHT(GET.WORKBOOK(1),LEN(GET.WORKBOOK(1))-FIND(""]"",GET.WORKBOOK(1)))"
X = Filter([index(shtNames,)], strIn, True, 1)

Select Case UBound(X)
    Case Is > 0
        strIn = Application.InputBox(Join(X, Chr(10)), "Multiple matches found - type position to select", , , , , 1)
        If strIn = "False" Then Exit Sub
        On Error Resume Next
        Sheets(CStr(X(strIn))).Activate
        On Error GoTo 0
    Case 0
        Sheets(X(0)).Activate
    Case Else
        MsgBox "No match"
End Select

End Sub