Question

我有一个名为SheetNameCol的集合，其中包含表格名称，例如Act Collection，Act，Les。

我有另一个名为HeaderRowCol的集合，其中包含Header Rows 7,8,9。

来自SheaderRow的SheetNameCol和Header行的工作表名称是相关的。

index   SheetNameCol      HeaderRowCol
1        Act Collection    7
2        Act               8
3        Les               9

我想根据工作表名称中的字符数对SheetNameCol进行排序。

所以我的预期输出将是： -

index   SheetNameCol      HeaderRowCol
1       Act                 8
2       Les                 9
3       Act Collection      7

如何更有效地完成此操作？请注意，HeaderRowCol也已根据SheetNameCol中的更改进行了更改。

我知道，我必须创建一个具有更多字符数的新集合来实现这一点 - 所以，我已经开始这样了 -

Set SortSheetNameCol = New Collection

    For l = 1 To SheetNameCol.Count

    ReqLength = Len(SheetNameCol(l))

    SortSheetNameCol.Add ReqLength

    Next

但我在这里有一个明确的逻辑。

Answer 1

这就是我使用工作表的意思

Option Explicit

Sub test()

    Application.ScreenUpdating = False

    Dim SheetNameCol As Collection
    Dim HeaderRowCol As Collection

    Set SheetNameCol = New Collection
    Set HeaderRowCol = New Collection

    SheetNameCol.Add "Act Collection"
    SheetNameCol.Add "Act"
    SheetNameCol.Add "Les"

    HeaderRowCol.Add 7
    HeaderRowCol.Add 8
    HeaderRowCol.Add 9

    If SheetNameCol.Count <> HeaderRowCol.Count Then
        MsgBox "Collections are of unequal item length"
        Exit Sub
    End If

    Dim arr()
    ReDim arr(0 To SheetNameCol.Count - 1, 0 To 2)
    Dim currItem As Long
    Dim itemCount As Long

    itemCount = SheetNameCol.Count

    For currItem = 1 To itemCount

        arr(currItem - 1, 0) = Len(SheetNameCol(currItem))
        arr(currItem - 1, 1) = SheetNameCol(currItem)
        arr(currItem - 1, 2) = HeaderRowCol(currItem)

    Next currItem

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets.Add

    With ws.Range("A1").Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1)

        .Value = arr
        .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Key2:=.Cells(1, 2), Order2:=xlAscending
        arr = .Value

    End With

    Application.DisplayAlerts = False

    ws.Delete

    Application.DisplayAlerts = True

    Set SheetNameCol = New Collection
    Set HeaderRowCol = New Collection

    For currItem = 1 To itemCount

        SheetNameCol.Add arr(currItem, 2)
        HeaderRowCol.Add arr(currItem, 3)

    Next currItem

    Application.ScreenUpdating = True

End Sub

结果：

Answer 2

您可以使用SortedList对象来利用其内置的自动排序并编写辅助子：

Sub SortCollections(coll1 As Collection, coll2 As Collection)
    Dim iItem  As Long

    With CreateObject("System.Collections.Sortedlist")
        For iItem = 1 To coll1.Count
            .Add Len(coll1.Item(iItem)) & "|" & coll1.Item(iItem), coll2.Item(iItem)
        Next
        Set coll1 = New Collection
        Set coll2 = New Collection
        For iItem = .Count - 1 To 0 Step -1
            coll1.Add Split(.getkey(iItem), "|")(1)
            coll2.Add .GetByIndex(iItem)
        Next
    End With
End Sub

这是一个如何使用它的例子

Sub Example()        
    Dim SheetNameCol As New Collection
    Dim HeaderRowCol As New Collection

    ' fill SheetNameCol 
    With SheetNameCol
        .Add "Act Collection"
        .Add "Act"
        .Add "Les"
    End With

    ' fill HeaderRowCol
    With HeaderRowCol
        .Add 7
        .Add 8
        .Add 9
    End With

    Dim iItem  As Long

    'list SheetNameCol and HeaderRowCol before sorting
    For iItem = 1 To SheetNameCol.Count
        MsgBox SheetNameCol.Item(iItem) & ", " & HeaderRowCol.Item(iItem)
    Next

    SortCollections SheetNameCol, HeaderRowCol ' sort

    'list SheetNameCol and HeaderRowCol after sorting
    For iItem = 1 To SheetNameCol.Count
        MsgBox SheetNameCol.Item(iItem) & ", " & HeaderRowCol.Item(iItem)
    Next
End Sub

Answer 3

虽然这个答案很晚，但这是另一种更符合您原始方法的解决方案。此代码不依赖于Excel：

$("#xId").val();

根据字符数对集合进行排序

3 个答案: