excel - 按字母顺序排序和过滤使用工作表名称自动填充的组合框

Question

这里的目标是在 50 多张 Excel 工作簿的首页上有一个下拉框，自动填充每个工作表名称，列表按字母顺序(升序)排序并过滤掉某些条目。

到目前为止，我已经有了这个(从这里开始 How to make a drop-down list for worksheets )来进行自动填充:

    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 个潜在的排序选项，但我遇到了如何将其与我已经拥有的内容结合起来的障碍。

Sort 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 仍在构建 CPU 之后，我还没有真正看过任何与代码相似的东西......)

社区可以提供的任何帮助/指导将不胜感激。

干杯。

抢。

Answer 1

这是我的做法，使用临时表进行排序，然后删除临时表。这也将忽略名称以“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