Алфавитная сортировка и фильтрация комбинированного поля, которое автоматически заполняется с использованием имен листов

Вот как я это сделал бы, используя временную таблицу для сортировки, а затем удаляю временный лист после. Это также игнорирует листы, чьи имена начинаются с «BETA», а также с первым листом в книге:

 Private Sub workbook_open() Dim ws As Worksheet Dim arrSheets As Variant Dim strSheets As String Dim lNumSheets As Long Dim cboSheets As MSForms.ComboBox Set cboSheets = ActiveWorkbook.Sheets(1).CmbSheet cboSheets.Clear For Each ws In ActiveWorkbook.Sheets If ws.Index > 1 And Not ws.Name Like "BETA*" Then lNumSheets = lNumSheets + 1 strSheets = strSheets & ":" & ws.Name End If Next ws Application.ScreenUpdating = False Application.DisplayAlerts = False With Sheets.Add.Range("A1").Resize(lNumSheets) .Value = Application.Transpose(Split(Mid(strSheets, 2), ":")) .Sort .Cells, xlAscending, Header:=xlNo arrSheets = .Value .Worksheet.Delete End With Application.DisplayAlerts = True Application.ScreenUpdating = True cboSheets.List = arrSheets End Sub 

Вы можете сделать другую подпроцедуру или функцию для сортировки:

 Sub SortWorksheets() Dim N As Integer Dim M As Integer Dim FirstWSToSort As Integer Dim LastWSToSort As Integer Dim SortDescending As Boolean SortDescending = False If ActiveWindow.SelectedSheets.Count = 1 Then FirstWSToSort = 2 LastWSToSort = Worksheets.Count Else With ActiveWindow.SelectedSheets For N = 2 To .Count If .Item(N - 1).Index <> .Item(N).Index - 1 Then MsgBox "You cannot sort non-adjacent sheets" Exit Sub End If Next N FirstWSToSort = .Item(1).Index LastWSToSort = .Item(.Count).Index End With End If For M = FirstWSToSort To LastWSToSort For N = M To LastWSToSort If left(UCase(Worksheets(N).Name,4) = "BETA" Else If SortDescending = True Then If UCase(Worksheets(N).Name) > UCase(Worksheets(M).Name) Then Worksheets(N).Move before:=Worksheets(M) End If Else If UCase(Worksheets(N).Name) < UCase(Worksheets(M).Name) Then Worksheets(N).Move before:=Worksheets(M) End If End If End If Next N Next M End Sub 

FirstWSToSort вы можете изменить – я установил его на 2, потому что вы сказали, что не хотите включать экран заголовка.

Вы можете сортировать по убыванию, изменив SortDescending на true.

Вы можете включать или удалять дополнительные условия в инструкции If в циклах N и M:

 If left(UCase(Worksheets(N).Name,4) = "BETA" 

Мне нравится идея выбора case для игнорирования рабочих листов. Также, возможно, проще всего сначала ввести действительные листы в массив, затем отсортировать массив, а затем прокрутить его, чтобы добавить элементы в поле со списком

Ex.

 Private Sub workbook_open() Dim lsheets As Worksheet Dim validSheets() As Worksheet ReDim validSheets(0) For Each lsheets In ActiveWorkbook.Sheets Select Case UCase(Left(lsheets.name, 4)) Case "BETA": 'sheet's name is beta MsgBox "beta" Case Else 'sheet's name is not beta 'put code to add sheet to combobox here MsgBox "not beta" 'if the last item in the array is used then increase array size If Not validSheets(UBound(validSheets)) Is Nothing Then ReDim Preserve validSheets(0 To UBound(validSheets) + 1) End If 'add valid sheet to last place in array Set validSheets(UBound(validSheets)) = lsheets End Select Next lsheets 'now sort the array of valid sheets exampleFunctionSort validSheets 'now add the array of valid sheets in order Dim index As Integer For index = LBound(validSheets) To UBound(validSheets) 'add sheet here Next index End Sub 'place array sort code here Private Function exampleFunctionSort(arr As Variant) End Function 

Woo Hoo! Мое время сиять. (Мне нравится краткость.)

 Private Sub workbook_open() Dim LSheets As Excel.Worksheet Dim OCmbBox As MSForms.ComboBox Set OCmbBox = ActiveWorkbook.Sheets(1).CmbSheet Dim sht As Worksheet OCmbBox.Clear With CreateObject("System.Collections.ArrayList") For Each sht In ThisWorkbook.Worksheets If sht.Name <> "BETA" Then .Add sht.Name Next .Sort OCmbBox.List = Application.Transpose(.toarray()) End With 

End Sub