VBA贷款分桶报表输出顺序不符问题求助

问题说明 #

我编写的VBA代码用于生成贷款分桶报表，但输出的Bucket顺序不符合预期：
当前输出顺序：

• Less Than 35 Lakhs
• 35 Lakhs to 75 Lakhs
• 3cr to 5cr
• 75 Lakhs to 1Cr
• 1cr to 3cr
• 5cr to 10cr
• 10crs and above

期望的正确顺序：

• Less Than 35 Lakhs
• 35 Lakhs to 75 Lakhs
• 75 Lakhs to 1Cr
• 1cr to 3cr
• 3cr to 5cr
• 5cr to 10cr
• 10crs and above

使用环境：Office 2016 和 365

问题原因 #

默认字符串排序是按字符ASCII顺序比较的，"3cr..."的首字符"3" ASCII值小于"75 Lakhs..."的首字符"7"，导致分桶顺序混乱。以下是三种可行的解决方法：

解决方案1：预定义正确顺序的分桶列表（最直接） #

直接在代码中定义好符合预期的分桶顺序数组，遍历数组生成报表，彻底避免排序问题：

' 预定义正确顺序的分桶数组
Dim bucketOrder As Variant
bucketOrder = Array( _
    "Less Than 35 Lakhs", _
    "35 Lakhs to 75 Lakhs", _
    "75 Lakhs to 1Cr", _
    "1cr to 3cr", _
    "3cr to 5cr", _
    "5cr to 10cr", _
    "10crs and above" _
)

' 按顺序处理每个分桶
Dim bucket As Variant
For Each bucket In bucketOrder
    ' 替换为你的分桶数据计算、报表写入逻辑
    ' 示例：Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = bucket
Next bucket

解决方案2：给分桶绑定排序权重，按权重排序 #

如果分桶是动态生成的，可通过字典给每个分桶分配排序权重，再按权重排序：

' 创建字典存储分桶与排序权重的映射
Dim bucketWeights As Object
Set bucketWeights = CreateObject("Scripting.Dictionary")
With bucketWeights
    .Add "Less Than 35 Lakhs", 1
    .Add "35 Lakhs to 75 Lakhs", 2
    .Add "75 Lakhs to 1Cr", 3
    .Add "1cr to 3cr", 4
    .Add "3cr to 5cr", 5
    .Add "5cr to 10cr", 6
    .Add "10crs and above", 7
End With

' 假设bucketsArray是存储乱序分桶的数组
Dim bucketsArray As Variant
bucketsArray = Array("3cr to 5cr", "Less Than 35 Lakhs", "75 Lakhs to 1Cr")

' 冒泡排序：按权重重新排列数组
Dim i As Integer, j As Integer, temp As String
For i = LBound(bucketsArray) To UBound(bucketsArray) - 1
    For j = i + 1 To UBound(bucketsArray)
        If bucketWeights(bucketsArray(i)) > bucketWeights(bucketsArray(j)) Then
            temp = bucketsArray(i)
            bucketsArray(i) = bucketsArray(j)
            bucketsArray(j) = temp
        End If
    Next j
Next i

' 排序后处理分桶
For Each bucket In bucketsArray
    ' 替换为你的业务逻辑
    Debug.Print bucket
Next bucket

解决方案3：利用Excel自定义列表排序（分桶数据在工作表中时） #

如果分桶最终写入Excel工作表，可通过自定义列表实现排序：

' 创建自定义排序列表
Dim customList As Variant
customList = Array( _
    "Less Than 35 Lakhs", _
    "35 Lakhs to 75 Lakhs", _
    "75 Lakhs to 1Cr", _
    "1cr to 3cr", _
    "3cr to 5cr", _
    "5cr to 10cr", _
    "10crs and above" _
)
Application.AddCustomList ListArray:=customList

' 假设分桶数据在A1:A7区域，按自定义列表排序
Range("A1:A7").Sort Key1:=Range("A1"), Order1:=xlAscending, _
                    Header:=xlNo, OrderCustom:=Application.CustomListCount + 1

' 可选：删除自定义列表，避免占用列表名额
Application.DeleteCustomList Application.CustomListCount

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