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

Цель здесь состоит в том, чтобы на первой странице более 50 листов книги Excel была выпадающая рамка, которая автоматически заполняется с каждым именем листа, а список сортируется в алфавитном порядке (по возрастанию) и отфильтровывает определенные записи.

Пока у меня есть это (что работает, отсюда, как сделать раскрывающийся список для рабочих листов ), чтобы выполнить автозаполнение:

Private Sub workbook_open() Dim LSheets As Excel.Worksheet Dim OCmbBox As MSForms.ComboBox Set OCmbBox = ActiveWorkbook.Sheets(1).CmbSheet OCmbBox.Clear For Each LSheets In ActiveWorkbook.Sheets OCmbBox.AddItem LSheets.Name Next LSheets End Sub 

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

В другом месте здесь я нашел 2 возможных варианта сортировки, но я нахожу блок, как объединить это с тем, что у меня уже есть.

Сортировать Combobox VBA

Что касается фильтрации, я смотрел на структуру типа SELECT CASE, но не мог понять, как помечать как отрицательный.

Что-то вроде этого:

  Private Sub workbook_open() Dim LSheets As Excel.Worksheet Dim OCmbBox As MSForms.ComboBox Set OCmbBox = ActiveWorkbook.Sheets(1).CmbSheet OCmbBox.Clear For Each LSheets In ActiveWorkbook.Sheets If UCase(Left(LSheets.Name, 4)) IS NOT "BETA": OCmbBox.AddItem LSheets.Name Else Next Lsheets End Sub 

Но вы даже не хотите знать отвратительные ошибки, которые дали мне! Для начала нет IS NOT, и! = Никуда меня не доставил (да, я на самом деле не смотрел ни на что, даже отдаленно напоминающее код, поскольку Cyrix все еще строил процессор …)

Любая помощь / руководство, которое может предоставить сообщество, было бы с благодарностью принято.

Приветствия.

Роб.

Вот как я это сделал бы, используя временную таблицу для сортировки, а затем удаляю временный лист после. Это также игнорирует листы, чьи имена начинаются с «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

  • Заполнение ComboBox с именами листов динамически
  • Получение «ошибки времени выполнения» 380: Не удалось установить свойство Value. Недопустимое значение свойства. "При присвоении значения свойству combobox 'value'
  • EXCEL VBA: цветовое кодирование данных проверки данных программно в раскрывающемся списке и вставка в ячейку
  • VBA итеративно заданные переменные
  • автоматическое заполнение поля с параметрами основного
  • Текст и значение для combobox Excel VBA
  • Excel VBA: событие ComboBox_Click запускается для любых изменений на любом рабочем листе
  • vba Если для параметра «Коробка» выбрано «Местоположение», тогда напишите «Loc»,
  • VBA: использование двумерного массива для заполнения нескольких различных комбинированных ящиков
  • Excel VBA - вставка значений в многоколоночный combobox
  • Заполнение комбинированной коробки колонкой из листа Excel C #
  • Interesting Posts

    Отфильтрованная таблица, показывающая ряды вне диапазона фильтра

    Экспорт / сохранение списка Python для диапазона переменных в существующем листе .xlsm

    Отображать окно сообщения, когда vlookup возвращает или не возвращает совпадение

    Размер ячейки автофита (обе строки и столбцы) после вставки изображения

    MS ACCESS – VBA – ФОРМЫ, КАСАЮЩИЕСЯ ДАННЫХ ДИСПЛЕЯ

    Запишите файл данных pandas в файл xlsm (Excel с включенными макросами)

    Большая загрузка данных на сервер, лучше в кусках?

    Обработка ошибок VBA Несколько раз

    Исходное литье get_Range исключает исключение

    Средние значения для ячейки, содержащей как число, так и текст – Excel

    SAS Import – файл не существует

    Очистить ячейки с определенным содержимым в VBA

    Как сделать обратное преобразование преобразованных значений Log10 индивидуально?

    Excel показывает 1:30 с 12:30 до 13:00

    Включить / отключить флажок в пользовательской области задач Excel Добавить с помощью OnEvents

    Давайте будем гением компьютера.