Excel根据名称查找工作表 [英] Excel Find a sheet based on name

问题描述

这不是一个问题，就像一个解决方案一样，但是我想在这里分享一下，因为我已经得到了我需要的帮助。

This is not a question, so much as a solution, but I wanted to share it here as I had gotten help for things I needed here.

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

I wanted to find a specific Excel sheet, in the Active Workbook, searching by the name of the sheet. I built this to find it. It is a "contains" search, and will automatically go to the sheet if it is found, or ask the user if there are multiple matches:

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

To end at any time, just enter a blank in the input box.

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

我希望有人认为这有用，也欢迎增强建议。 >

I hope someone finds this useful, and would also welcome enhancement suggestions.

推荐答案

为了乐趣，尽可能地以尽可能少的行执行循环

For fun tried to do this in as few lines as possible with loops

使用范围名称xlm和VBS使用过滤器以提供与上述相同的多表单搜索功能。

Uses a range name, xlm, and VBS under utilised Filter to provide the same multi-sheet search functionality as above.

大部分代码涉及工作表选择部分

The bulk of the code relates to the sheet selection portion

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

这篇关于Excel根据名称查找工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！