vba - 使用每个单元格中间的字符按列排序，无需辅助列

Question

是否可以按列对范围进行排序，但使用每个单元格中字符串中间的单个字符进行排序？

所以列看起来像这样:

red(7)
blue(4)
orange(9)
green(2)
etc..

我想使用括号内的数字对其进行排序。

我当前的代码按字母顺序对列进行排序:

With sheetSUMMARY

.Range(.Cells(summaryFirstRow, summaryReForenameCol)), _
    .Cells(summaryLastRow, summaryReColourCol))). _
Sort _
key1:=.Range(.Cells(summaryFirstRow, summaryReColourCol)), _
    .Cells(summaryLastRow, summaryReColourCol))), _
order1:=xlAscending, _
Header:=xlNo

End With

所以它看起来像这样:

blue(4)
green(2)
orange(9)
red(7)

如果不在Excel中创建辅助列(提取数字)，是否可以纯粹以编程方式对其进行排序？ (现阶段我还没有真正的空间来放置辅助列)

green(2)
blue(4)
red(7)
orange(9)

Answer 1

您可以使用字典来存储您的值及其对应的数字，然后有多种排序方法。我选择使用 ArrayList 来进行排序，而不是编写定制的排序函数。

Public Sub SortByNumber()
    Dim arrayList As Object, inputDictionary As Object, outputDictionary As Object 'late binding so you can drop the code in easily
    Dim rng As Range, r As Range
    Dim num As Double
    Dim v As Variant

    Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1:A4")
    Set arrayList = CreateObject("System.Collections.ArrayList")
    Set inputDictionary = CreateObject("Scripting.Dictionary")
    Set outputDictionary = CreateObject("Scripting.Dictionary")

    'put current values into dictionary and arraylist
    For Each r In rng
        num = CLng(Mid(r.Value, InStr(r.Value, "(") + 1, Len(r.Value) - InStr(r.Value, "(") - 1))
        Do While inputDictionary.exists(num) 'avoid errors with duplicates numbers (see comments)
            num = num + 0.00000001
        Loop
        inputDictionary.Add Item:=r.Value, Key:=num
        arrayList.Add num
    Next r

    arrayList.Sort

    'use sorted arraylist to determine order of items in output dictionary
    For Each v In arrayList.toarray
        outputDictionary.Add Item:=v, Key:=inputDictionary.Item(v)
    Next v

    'output values to the next column -- just remove the offset to overwrite original values
    rng.Offset(0, 1).Value = WorksheetFunction.Transpose(outputDictionary.keys())
End Sub

<小时/>

结果如下所示: