Excel根据名称查找工作表

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

我想find一个特定的Excel工作表，在活动工作簿中，通过工作表名称进行search。 我build立这个find它。 这是一个“包含”search，如果find，它将自动转到表单，或询问用户是否有多个匹配项：

要随时结束，只需在input框中input一个空格。

 Public Sub Find_Tab_Search（）
    昏暗sSearch作为string
     sSearch =“”
     sSearch = InputBox（“inputsearch”，“查找标签”）
    如果修剪（sSearch）=“”然后退出子
     'MsgBox（sSearch）

    昏暗sSheets（）作为string
     Dim sMatchMessage As String
    昏暗的iWorksheets作为整数
    昏暗的iCounter作为整数
     Dim iMatches As Integer
     Dim iMatch As Integer
    昏暗的sGet作为string
    昏暗s作为string提示

     iMatch = -1
     iMatches = 0
     sMatchMessage =“”

     iWorksheets = Application.ActiveWorkbook.Sheets.Count
     ReDim sSheets（iWorksheets）

     '放入数组中的名字列表
    对于iCounter = 1到iWorksheets
         sSheets（iCounter）= Application.ActiveWorkbook.Sheets（iCounter）.Name
        如果InStr（1，sSheets（iCounter），sSearch，vbTextCompare）> 0然后
             iMatches = iMatches + 1
            如果iMatch = -1那么iMatch = iCounter
             sMatchMessage = sMatchMessage + CStr（iCounter）+“：”+ sSheets（iCounter）+ vbCrLf
        万一
    下一个iCounter

    select案例iMatches
        情况0
             '无匹配
             MsgBox“找不到”+ sSearch
        情况1
             '1匹配激活表单
             Application.ActiveWorkbook.Sheets（iMatch）.Activate
        其他情况
             “不止一场比赛。 询问他们要去哪个表
             sGet = -1
             sPrompt =“find多个匹配项，请从下面的列表中input”
             sPrompt = sPrompt +“显示工作表”+ vbCrLf + vbCrLf + sMatchMessage
             sPrompt = sPrompt + vbCrLf + vbCrLf +“input空白取消”
             sGet = InputBox（sPrompt，“请select一个”）
            如果修剪（sGet）=“”然后退出子
             sPrompt =“值必须是数字”+ vbCrLf + vbCrLf + sPrompt
             IsNumeric（sGet）= False时做
                 sGet = InputBox（sPrompt，“请select一个”）
                如果修剪（sGet）=“”然后退出子
            循环
             iMatch = CInt（sGet）
             Application.ActiveWorkbook.Sheets（iMatch）.Activate
    结束select

结束小组

我希望有人认为这是有用的，也欢迎提高build议。

Answer 1

为了好玩，试图用尽可能less的循环来做到这一点

使用范围名称，xlm和VBS使用的Filter来提供与上面相同的多页searchfunction。

大部分代码涉及到纸张select部分

 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