使用每个单元格中间的字符按列排序，没有辅助列

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

您可以使用Dictionary存储您的值及其相应的数字，然后有许多排序方法。我选择使用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

结果如下：

Answer 2

如果你真的不想添加辅助列，你可以做一些有趣的事情。几乎以下几点：

• 假设您的inputRange是Range("A1:A4")

• 声明变体virtualRange，这有点棘手 - 它会采用inputRange和下一列的值：

  virtualRange = Union(inputRange, inputRange.Offset(0, 1)).Value

• 然后循环浏览inputRange并将单元格值分配给virtualRange的第二维。它应该在本地窗口中看起来像这样：

• 现在有趣的部分 - 将virtualRange传递给SortDataBySecondValue，它将返回已排序的virtualRange。这是一个非常重要的观点 - 如果您使用括号传递virtualRange，就像这样SortDataBySecondValue (virtualRange)没有任何用处 - 括号将取代ByRef中的SortDataBySecondValue()参数和{ {1}}仍未解决。

• 最后，您的virtualRange已排序，您必须将其值正确传递给inputRange。这可以通过简单的循环实现：

  virtualRange

• 现在For Each myCell In inputRange Dim cnt As Long cnt = cnt + 1 myCell = virtualRange(cnt, 1) Next myCell按预期排序：

整个代码在这里：

inputRange

Answer 3

试试这个：

Sub OrderByColumn()
Dim i As Long, tempColumn As Long, colorColumn As Long, color As String
'get table to variable
Dim tableToOrder As Range
'here ypou have to specify your own range!!
Set tableToOrder = Range("A1:C5")
colorColumn = tableToOrder.Column
tempColumn = colorColumn + tableToOrder.Columns.Count
'insert new column at the end of the table and populate with extracted numbers
Columns(tempColumn).Insert
For i = tableToOrder.Row To (tableToOrder.Rows.Count + tableToOrder.Row - 1)
    color = Cells(i, colorColumn).Value
    Cells(i, tempColumn).Value = Mid(color, InStr(1, color, "(") + 1, InStr(1, color, ")") - InStr(1, color, "(") - 1)
Next
i = i - 1 'now i points to last row in range
'order whole table accordingly to temporary column
Range(Cells(tableToOrder.Row, tableToOrder.Column), Cells(i, tempColumn)).Sort Key1:=Range(Cells(tableToOrder.Row, tempColumn), Cells(i, tempColumn))
'delete column
Columns(tempColumn).Delete
End Sub