Excel 根据名称查找工作表

这不是一个问题，而是一个解决方案，但我想在这里分享它，因为我在这里得到了我需要的帮助。

我想在活动工作簿中查找特定的 Excel 工作表，并按工作表名称进行搜索。我构建这个是为了找到它。这是一个“包含”搜索，如果找到，会自动转到工作表，或者询问用户是否有多个匹配项：

要随时结束，只需在输入框中输入空格即可。

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
  

我希望有人觉得这很有用，并且也欢迎改进建议。

为了好玩，尝试使用循环以尽可能少的行数来完成此操作

使用未充分利用的范围名称、xlm 和 VBSFilter提供与上面相同的多表搜索功能。

大部分代码与工作表选择部分相关

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