按照中文数字升降序问题

ykcbf1100

1. Sub ykcbf()  '//2025.3.26    按关键字模糊排序
   
2.     Application.ScreenUpdating = False
   
3.     With ActiveSheet
   
4.         col = 7
   
5.         r = .Cells(.Rows.Count, col).End(3).Row
   
6.         st = "一、二、三、四、五、六、七、八、九、十、十一、十二、十三、十四、十五、十六"
   
7.         px = Split(st, "、")
   
8.         Set Rng = .Range("A4:G" & r)   '//排序范围
   
9.         arr = Rng.Value
   
10.         For i = LBound(arr, 1) To UBound(arr, 1) - 1
    
11.             For j = i + 1 To UBound(arr, 1)
    
12.                 key1 = GetKeyIndex(arr(i, col), px)
    
13.                 key2 = GetKeyIndex(arr(j, col), px)
    
14.                 If key1 > key2 Then
    
15.                     For k = LBound(arr, 2) To UBound(arr, 2)
    
16.                         temp = arr(i, k): arr(i, k) = arr(j, k): arr(j, k) = temp
    
17.                     Next
    
18.                 End If
    
19.             Next j
    
20.         Next i
    
21.         Rng.Value = arr
    
22.     End With
    
23.     Application.ScreenUpdating = True
    
24.     MsgBox "模糊排序完成！", vbInformation, "完成"
    
25. End Sub
    
26. 
    
27. Function GetKeyIndex(cellValue As Variant, keys As Variant) As Long
    
28.     Dim i As Long
    
29.     Dim foundIndex As Long
    
30.     Dim maxLen As Long
    
31.     foundIndex = UBound(keys) + 1
    
32.     maxLen = 0
    
33.     For i = UBound(keys) To LBound(keys) Step -1
    
34.         If InStr(1, cellValue, keys(i), vbTextCompare) > 0 Then
    
35.             If Len(keys(i)) > maxLen Then
    
36.                 maxLen = Len(keys(i))
    
37.                 foundIndex = i
    
38.             End If
    
39.         End If
    
40.     Next i
    
41.     GetKeyIndex = foundIndex
    
42. End Function
    
43. 
    

复制代码