如何用VBA对API获取的分隔字符串数据进行多维度分组排序？

需求说明 #

现有存储在VBA Dictionary中的数据行，每行以:::作为分隔符，格式为：
PM-xxxxx ::: 分组标识::: 优先级::: PI版本::: 描述内容
需要实现：

• 先按*第二个元素（分组标识，如AK、EA）*分组
• 每组内再按*第四个元素（PI版本，如Jupiter_PI6-1）*分组
• 每个PI分组内按*第一个元素（PM编号）*排序
  要求全程在VBA内存中处理，不依赖Excel工作表排序。

实现代码 #

Sub SortDictByGroupAndPM()
    ' 假设你的原始数据字典名为originalDict，键为任意唯一标识，值为分隔字符串
    Dim originalDict As Object
    Set originalDict = CreateObject("Scripting.Dictionary")
    
    ' -------------- 模拟填充原始数据（实际替换为你的API返回数据）--------------
    originalDict.Add 1, "PM-10663 ::: AK:::1:::Jupiter_PI6-1:::Relinquishment request cancled time out "
    originalDict.Add 2, "PM-10721 ::: AK:::3:::Jupiter_PI6-2:::Automate SAS Simulator configuration - Prepare Dummy test files"
    originalDict.Add 3, "PM-76960 ::: EA:::3:::Jupiter_PI6-1:::Handle Heartbeat Expire timer (interval) Received in Grant/Heartbeat Response"
    originalDict.Add 4, "PM-99200 ::: EA:::3:::Jupiter_PI6-1:::Scheduled Job Support First HeartBeat - Transmit Expiry"
    originalDict.Add 5, "PM-10684 ::: EA:::1:::Jupiter_PI6-2:::Update Swagger for Rest API to FE"
    originalDict.Add 6, "PM-10822 ::: EA:::1:::Jupiter_PI6-2:::Add Code Owners"
    originalDict.Add 7, "PM-10807 ::: EA:::2:::Jupiter_PI6-2:::Enabling SAS Cleaning Data "
    originalDict.Add 8, "PM-10327 ::: EA:::1:::Jupiter_PI6-2:::Add Coverage.out file to Domain-proxy repo to access to jenkins workspace"
    originalDict.Add 9, "PM-73860 ::: KO:::3:::Jupiter_PI6-1:::Algorithm to obtain grant requests for RUs within same bandwidth - Part 2"
    originalDict.Add 10, "PM-10472 ::: KO:::2:::Jupiter_PI6-1:::updating the api-spec go version"
    originalDict.Add 11, "PM-99370 ::: KO:::3:::Jupiter_PI6-1:::Build Swagger for Rest API to FE"
    originalDict.Add 12, "PM-10132 ::: KO:::5:::Jupiter_PI6-1:::Configure the SAS Simulator to test SAS errors"
    originalDict.Add 13, "PM-10029 ::: KO:::2:::Jupiter_PI6-2:::Consider moving to Orchestration NATS bus to facilitate the Authentication and Authorization"
    originalDict.Add 14, "PM-97240 ::: OM:::1:::Jupiter_PI6-1:::Define nats subject/schema definition for publish/subscribing CBSD_info_update message"
    originalDict.Add 15, "PM-98250 ::: OM:::1:::Jupiter_PI6-1:::Procure the NB swagger/gRPC specification of retrieving CBSD_info_update from CBRS"
    originalDict.Add 16, "PM-99420 ::: OM:::1:::Jupiter_PI6-1:::Configure the structure API client for DP"
    originalDict.Add 17, "PM-10661 ::: OM:::3:::Jupiter_PI6-2:::Relinquishment failed."
    originalDict.Add 18, "PM-10662 ::: OM:::1:::Jupiter_PI6-2:::Relinquishment request canceled time out "
    originalDict.Add 19, "PM-77000 ::: OM:::3:::Jupiter_PI6-2:::Create Transmit Expiry Timer in Heartbeat Response"
    originalDict.Add 20, "PM-93300 ::: OM:::3:::Jupiter_PI6-2:::Handle Grant Expire Timer Received in Grant Response - Part 2 "
    originalDict.Add 21, "PM-98440 ::: OM:::3:::Jupiter_PI6-2:::Expose a Rest API to FE to provide SAS Default URL"
    originalDict.Add 22, "PM-10217 ::: OM:::3:::Jupiter_PI6-1:::Hardcode the flow of DP - SAS communication"
    ' ---------------------------------------------------------------------------
    
    ' 构建多层分组字典：第一层=分组标识(AK/EA)，第二层=PI版本，值为存储PM编号和原始字符串的字典
    Dim groupDict As Object
    Set groupDict = CreateObject("Scripting.Dictionary")
    
    Dim key As Variant
    Dim splitArr As Variant
    Dim groupID As String, piVersion As String, pmID As String
    Dim piDict As Object, pmDict As Object
    
    ' 遍历原始字典，拆分数据并分组
    For Each key In originalDict.Keys
        splitArr = Split(Trim(originalDict(key)), ":::")
        ' 清理拆分后元素的首尾空格
        groupID = Trim(splitArr(1))
        piVersion = Trim(splitArr(3))
        pmID = Trim(splitArr(0))
        
        ' 第一层分组：不存在则创建新字典
        If Not groupDict.Exists(groupID) Then
            Set groupDict(groupID) = CreateObject("Scripting.Dictionary")
        End If
        Set piDict = groupDict(groupID)
        
        ' 第二层分组：不存在则创建新字典
        If Not piDict.Exists(piVersion) Then
            Set piDict(piVersion) = CreateObject("Scripting.Dictionary")
        End If
        Set pmDict = piDict(piVersion)
        
        ' 存入PM编号和原始字符串（PM编号确保唯一）
        If Not pmDict.Exists(pmID) Then
            pmDict.Add pmID, originalDict(key)
        End If
    Next key
    
    ' 生成排序后的结果数组
    Dim sortedResult As Variant
    ReDim sortedResult(1 To originalDict.Count)
    Dim resultIndex As Integer
    resultIndex = 1
    
    Dim sortedGroupKeys As Variant, sortedPIKeys As Variant, sortedPMKeys As Variant
    
    ' 1. 对分组标识的键排序
    sortedGroupKeys = SortDictionaryKeys(groupDict)
    Dim gKey As Variant
    For Each gKey In sortedGroupKeys
        Set piDict = groupDict(gKey)
        ' 2. 对PI版本的键排序
        sortedPIKeys = SortDictionaryKeys(piDict)
        Dim pKey As Variant
        For Each pKey In sortedPIKeys
            Set pmDict = piDict(pKey)
            ' 3. 对PM编号的键排序
            sortedPMKeys = SortDictionaryKeys(pmDict)
            Dim mKey As Variant
            For Each mKey In sortedPMKeys
                sortedResult(resultIndex) = pmDict(mKey)
                resultIndex = resultIndex + 1
            Next mKey
        Next pKey
    Next gKey
    
    ' ---------------- 输出排序结果（可替换为你的后续处理逻辑）----------------
    Dim i As Integer
    For i = 1 To UBound(sortedResult)
        Debug.Print sortedResult(i)
    Next i
    ' ---------------------------------------------------------------------------
End Sub

' 辅助函数：对字典的键进行升序排序
Function SortDictionaryKeys(dict As Object) As Variant
    Dim keysArr As Variant
    ReDim keysArr(1 To dict.Count)
    Dim i As Integer
    i = 1
    
    ' 将字典键存入数组
    Dim key As Variant
    For Each key In dict.Keys
        keysArr(i) = key
        i = i + 1
    Next key
    
    ' 冒泡排序（小规模数据适用，数据量大可替换为高效排序算法）
    Dim temp As Variant
    Dim j As Integer
    For i = LBound(keysArr) To UBound(keysArr) - 1
        For j = i + 1 To UBound(keysArr)
            If keysArr(i) > keysArr(j) Then
                temp = keysArr(i)
                keysArr(i) = keysArr(j)
                keysArr(j) = temp
            End If
        Next j
    Next i
    
    SortDictionaryKeys = keysArr
End Function

代码说明 #

1. 多层字典分组：通过三层字典实现层级分组，第一层管理分组标识，第二层管理PI版本，第三层存储对应PM编号和原始字符串，确保数据结构清晰。
2. 排序逻辑：借助辅助函数SortDictionaryKeys对各层字典的键进行升序排序，按「分组→PI版本→PM编号」的顺序输出有序结果。
3. 内存处理：全程在VBA内存中完成解析、分组、排序操作，无需读写Excel工作表，满足实时处理需求。

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