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

Posted 2023-03-10

【中文标题】按字母顺序排序和过滤使用工作表名称自动填充的组合框

【英文标题】：Alphabetically sorting and filtering a combo box that's being auto filled using sheet names

【发布时间】：2014-09-04 18:42:05

【问题描述】：

这里的目标是在 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 之后，我还没有真正看过任何与代码相似的东西......）

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

干杯。

罗伯。

【参考方案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

【讨论】：

您先生，是一个纯粹的传奇。非常非常感谢！

【参考方案2】：

您可以制作另一个子过程或函数进行排序：

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 来进行降序排序。

您可以在 N 和 M 循环内的 If 语句中包含或删除更多条件：

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

【讨论】：

那么如何/在哪里是调用该程序的最佳位置/方式？从创建列表的初始 workbook_open() 中？请记住，目前它位于 ThisWorkbook 的（代码）部分，而不是特定的工作表上。

另外，您的其中一行代码给了我一个编译错误。 '预期：列表分隔符或）'它发生在 For 部分中的“If left (UCase(Worksheets(N).Name,4) = "BETA" 行。看起来缺少一个括号，但我不能似乎弄清楚它应该去哪里，因为它仍然在我身上打破，。

【参考方案3】：

我喜欢忽略工作表的选择案例想法。此外，最简单的方法可能是先将有效的工作表放入一个数组中，然后对数组进行排序，然后循环遍历它以将项目添加到组合框

例如

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

【参考方案4】：

呜呼！我是时候发光了。 （我喜欢简洁。）

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

结束子