Excel 이름을 기반으로 한 쉬트 찾기

Question

이것은 해결책이 될만한 질문이 아니지만 여기서 필요한 도움을 얻었 기 때문에 여기서 공유하고 싶습니다.

활성 통합 문서에서 시트 이름으로 검색하는 특정 Excel 시트를 찾고 싶습니다. 나는 그것을 발견하기 위해 이것을 만들었습니다. 그것은 "contains"검색이며, 발견되면 자동으로 시트로 이동하거나 일치하는 것이 여러 개인 경우 사용자에게 묻습니다.

언제든지 끝내려면 입력란에 공백을 입력하면됩니다.

 
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 

누군가가 유용하다고 생각하고 개선 제안을 환영하기를 바랍니다. 재미에 대한

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