如何通过VBA代码按字体颜色对单元格内数据字符串排序

我的单元格中有一段数据字符串，希望按字体颜色对该字符串进行排序，请问能否编写对应的VBA代码实现该需求？以下是我尝试的代码：

Range("S37").Select
ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Add(Range("S37:S37"), _
    xlSortOnFontColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 102 _
    , 0)
With ActiveWorkbook.Worksheets("sheet1").Sort
    .SetRange Range("S37:S37")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

原代码问题说明 #

你使用的Excel内置Sort功能是针对单元格区域的排序，无法处理单个单元格内部的字符按字体颜色分类排序，因此这段代码无法实现你的需求。

实现单个单元格内字符按字体颜色排序的VBA代码 #

Sub SortCharsByFontColor()
    Dim targetCell As Range
    Dim charCount As Integer
    Dim i As Integer
    Dim colorGroups As Object
    Dim currentColor As Long
    Dim sortedText As String
    Dim colorKey As Variant
    Dim pos As Integer
    
    '指定目标单元格，可根据需求修改
    Set targetCell = ThisWorkbook.Worksheets("sheet1").Range("S37")
    Set colorGroups = CreateObject("Scripting.Dictionary")
    
    charCount = targetCell.Characters.Count
    
    '遍历字符，按字体颜色分组
    For i = 1 To charCount
        currentColor = targetCell.Characters(i, 1).Font.Color
        If Not colorGroups.Exists(currentColor) Then
            colorGroups.Add currentColor, ""
        End If
        colorGroups(currentColor) = colorGroups(currentColor) & targetCell.Characters(i, 1).Text
    Next i
    
    '按颜色值升序拼接字符（若要指定颜色顺序，可手动调整遍历逻辑）
    sortedText = ""
    For Each colorKey In colorGroups.Keys
        sortedText = sortedText & colorGroups(colorKey)
    Next colorKey
    
    '写回排序后的文本并恢复字体颜色
    targetCell.Value = sortedText
    pos = 1
    For Each colorKey In colorGroups.Keys
        targetCell.Characters(pos, Len(colorGroups(colorKey))).Font.Color = colorKey
        pos = pos + Len(colorGroups(colorKey))
    Next colorKey
End Sub

代码说明 #

• 用Scripting.Dictionary存储不同字体颜色对应的字符集合，实现同颜色字符归类
• 遍历单元格内每个字符，按颜色分组存储
• 按颜色值升序拼接字符（如果需要指定特定颜色顺序，比如先绿色再黑色，可手动定义颜色数组并遍历）
• 最后将排序后的文本写回单元格，同时恢复每个字符的原始字体颜色

内容的提问来源于stack exchange，提问作者Rajiv Narula