在Excel中基于名称查找工作表

Question

这不是一个问题，更像是一个解决方案，但我想在这里分享它，因为我在这里得到了所需的帮助。我想要通过工作表名称在活动工作簿中查找一个特定的Excel表格，并编写了以下代码来实现 "包含" 搜索。如果找到该表格，则会自动转到该表格，否则会询问用户是否存在多个匹配项：要随时结束搜索，请只需在输入框中输入空格即可。

Public Sub Find_Tab_Search()
    Dim sSearch As String
    sSearch = ""
    sSearch = InputBox("请输入搜索内容", "查找表格")
    If Trim(sSearch) = "" Then Exit Sub
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)
'将工作表名称放入数组中
    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
            '没有匹配项
            MsgBox "未找到与 " + sSearch + " 相关的表格"
        Case 1
            '仅有一个匹配项，激活该表格
            Application.ActiveWorkbook.Sheets(iMatch).Activate
        Case Else
            '有多个匹配项，询问用户应转到哪个工作表
            sGet = -1
            sPrompt = "找到多个匹配项。请选择需要查看的表格编号：" + vbCrLf + vbCrLf + sMatchMessage
            sPrompt = sPrompt + vbCrLf + vbCrLf + "输入空格以取消"
            sGet = InputBox(sPrompt, "请选择一个表格")
            If Trim(sGet) = "" Then Exit Sub
            sPrompt = "请输入数字" + vbCrLf + vbCrLf + sPrompt
            Do While IsNumeric(sGet) = False
                sGet = InputBox(sPrompt, "请选择一个表格")
                If Trim(sGet) = "" Then Exit Sub
            Loop
            iMatch = CInt(sGet)
            Application.ActiveWorkbook.Sheets(iMatch).Activate
    End Select
End Sub

我希望这对大家有所帮助，也欢迎提出改进建议。

- JustDaveN

---

欢迎来到Stack Overflow！感谢您与社区分享这个解决方案。您可以在“提问”页面底部勾选“回答自己的问题”框，同时提出问题并发布答案。我建议您将答案移至实际答案中，然后重写问题以解决该答案。 - Brian

请您将此内容改写成问题形式并回答，以符合SO的格式。话虽如此，欢迎您的加入，并感谢您添加了有用的内容。 - Our Man in Bananas

@Brian，提醒一下，声望低的用户无法回答自己的问题。 - Sifu

@Sifu 谢谢，我没有意识到这一点。根据stackoverflow.com/help/self-answer的规定，原帖发布者需要至少15个声望才能回答自己的问题。这意味着由于三个赞同票，原帖发布者现在已经有足够的声望了。 - Brian

Answer 1

为了有趣尝试使用循环以尽可能少的行数完成此操作

使用一个范围名称、xlm和VBS未被充分利用的Filter，提供与上述相同的多表搜索功能。

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

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

- brettdj