序号排序

xzh_yzcn

各位老师
我想用vba实际序号自动排序，未得到目标排序结果，请指点。谢谢

序号	项目名称
一	主要生产工程
1	主变压器系统
1.1	主变压器
2	配电装置
2.1	屋内配电装置
3	无功补偿
3.5	静止无功补偿装置
4	控制及直流系统
4.1	计算机监控系统
4.2	继电保护
5	站用电系统
5.1	站用变压器
6	电缆及接地
6.1	全站电缆
6.2	全站接地
7	通信及远动系统
7.2	远动及计费系统
2.1.1	110kV配电装置
2.1.2	10kV配电装置
4.1.1	计算机监控系统
6.1.1	电力电缆
6.1.2	控制电缆
6.1.3	电缆辅助设施
6.1.4	电缆防火

以下是排序目标结果值

序号	项目名称
一	主要生产工程
1	主变压器系统
1.1	主变压器
2	配电装置
2.1	屋内配电装置
2.1.1	110kV配电装置
2.1.2	10kV配电装置
3	无功补偿
3.5	静止无功补偿装置
4	控制及直流系统
4.1	计算机监控系统
4.1.1	计算机监控系统
4.2	继电保护
5	站用电系统
5.1	站用变压器
6	电缆及接地
6.1	全站电缆
6.1.1	电力电缆
6.1.2	控制电缆
6.1.3	电缆辅助设施
6.1.4	电缆防火
6.2	全站接地
7	通信及远动系统
7.2	远动及计费系统

请指点，excel中排序也得不到这个目标排序结果。

序号排序.zip (4.57 KB, 下载次数: 19)

2018-8-28 13:37 上传

点击文件名下载附件

一把小刀闯天下

'每位最大支持99，最大支持3级（可修改）

Option Explicit

Sub test()
  Dim arr, i, j, k, t
  With Sheets("排序前")
    arr = .Range("a3:c" & .Cells(Rows.Count, "a").End(xlUp).Row)
  End With
  For i = 1 To UBound(arr, 1)
    If InStr(arr(i, 1), ".") = 0 Then
      arr(i, 3) = arr(i, 1) * 10 ^ 4
    Else
      t = Split(arr(i, 1), ".")
      If UBound(t) = 1 Then
        arr(i, 3) = t(0) * 10 ^ 4 + t(1) * 10 ^ 2
      Else
        arr(i, 3) = t(0) * 10 ^ 4 + t(1) * 10 ^ 2 + t(2)
      End If
    End If
  Next
  For i = 1 To UBound(arr, 1) - 1
    For j = i + 1 To UBound(arr, 1)
      If arr(i, 3) > arr(j, 3) Then
        For k = 1 To UBound(arr, 2)
          t = arr(i, k): arr(i, k) = arr(j, k): arr(j, k) = t
        Next
      End If
  Next j, i
  With Sheets("目标结果").[a3]
    .Resize(Rows.Count - 2, 2).ClearContents
    .Resize(UBound(arr, 1), 2) = arr
  End With
End Sub

Zamyi

1. Sub sort()
   
2. r = Range("a3", [a65536].End(3))
   
3. For i = 1 To UBound(r)
   
4.   r(i, 1) = G(r(i, 1))
   
5. Next
   
6. Range("c3").Resize(UBound(r)) = r
   
7. Range("c3", [a65536].End(3)).sort [c3], 1
   
8. Range("c:c") = ""
   
9. End Sub
   
10. Function G(s)
    
11. G = String(6, "0")
    
12. For Each c In Split(s, ".")
    
13.   Mid(G, i + 1) = Format(c, "00")
    
14.   i = i + 2
    
15. Next
    
16. End Function
    

复制代码

xzh_yzcn

一把小刀闯天下 发表于 2018-8-28 15:42
'每位最大支持99，最大支持3级（可修改）

Option Explicit

谢谢老师，谢谢老师