如何实现通过输入部分工作表名称跳转至目标工作表？

Great question! Modifying your VBA code to support partial sheet name matching is totally doable, and it’ll make navigating your workbook way easier when you only know part of the sheet name (like that ID without the currency suffix).

Here’s a revised version of your code that handles partial matches, plus extra logic to deal with common scenarios like multiple matching sheets or no matches at all:

Sub SelectSheetPartialMatch()
    Dim inputStr As Variant
    Dim ws As Worksheet
    Dim matchingSheets As Collection
    Dim selectedSheet As String
    
    ' Get user input (Type:=2 ensures we get text input)
    inputStr = Application.InputBox("Enter partial worksheet name (e.g., ID number)", "Select Sheet by Partial Match", Type:=2)
    
    ' Handle cancel or empty input
    If inputStr = False Or inputStr = "" Then
        MsgBox "No input provided. Exiting.", vbInformation
        Exit Sub
    End If
    
    ' Initialize collection to store matching sheet names
    Set matchingSheets = New Collection
    
    ' Loop through all worksheets to find matches
    For Each ws In ThisWorkbook.Worksheets
        ' Check if sheet name contains the input string (case-insensitive)
        If InStr(1, ws.Name, inputStr, vbTextCompare) > 0 Then
            matchingSheets.Add ws.Name
        End If
    Next ws
    
    ' Handle different match scenarios
    Select Case matchingSheets.Count
        Case 0
            MsgBox "No worksheets found containing """ & inputStr & """.", vbExclamation
        Case 1
            ' Only one match: activate it directly
            ThisWorkbook.Worksheets(matchingSheets(1)).Activate
            MsgBox "Navigated to worksheet: " & matchingSheets(1), vbInformation
        Case Else
            ' Multiple matches: let user select from a list
            Dim matchList As String
            matchList = Join(GetCollectionAsArray(matchingSheets), vbCrLf)
            
            selectedSheet = Application.InputBox("Multiple matches found. Select a worksheet:" & vbCrLf & matchList, "Choose Worksheet", Type:=2)
            
            ' Validate selection and activate
            On Error Resume Next
            ThisWorkbook.Worksheets(selectedSheet).Activate
            If Err.Number <> 0 Then
                MsgBox "Invalid selection. Exiting.", vbExclamation
            Else
                MsgBox "Navigated to worksheet: " & selectedSheet, vbInformation
            End If
            On Error GoTo 0
    End Select
End Sub

' Helper function to convert collection to array for easy list formatting
Function GetCollectionAsArray(col As Collection) As Variant
    Dim arr() As String
    ReDim arr(1 To col.Count)
    
    For i = 1 To col.Count
        arr(i) = col(i)
    Next i
    
    GetCollectionAsArray = arr
End Function

Let me walk through the key improvements:

• Case-Insensitive Partial Matching: Uses vbTextCompare in InStr so you don’t have to worry about matching uppercase/lowercase exactly.
• Graceful Error Handling: Catches cancel clicks, empty inputs, and invalid selections without crashing.
• Multiple Match Support: If your input matches multiple sheets (like the same ID with different currencies), it shows a list of all matches so you can pick the right one.
• Clear Feedback: Alerts you when no matches are found or confirms successful navigation.

To use this, replace your existing SelectSheet subroutine with this code, or rename it to something like SelectSheetPartialMatch if you want to keep both versions.

内容的提问来源于stack exchange，提问作者Mike Mann