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”一词开头的任何表格

在这里的其他地方，我发现了两种可能的排序选项，但是我在如何将其与我已经拥有的内容结合起来。

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

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

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"

Answer 2

这是我怎么做的，使用临时表进行排序，然后删除临时表。这也将忽略名称以＆＃34; BETA＆＃34;以及工作簿中的第一张表：

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

Answer 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

Answer 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

End Sub

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

4 个答案: