关于VBA特殊排序的紧急求助

莫悠悠

请教：如何用VBA对左边数据进行排序？
特别是想实现在增减科目、修改科目的时候自动进行排序，后面还有很多其他科目。
E列：辅助、F列：排序后正确序号，最终是不要的。

KCFONG

see if help you

yaozong

Private Sub CommandButton1_Click()
  Dim arr, t, i&, j&, k&, m&, n&
  arr = Range("e2", Cells(Rows.Count, 1).End(3))
  m = UBound(arr): n = UBound(arr, 2)
  For i = 1 To UBound(arr)
    arr(i, 5) = Val(arr(i, 1) & String(9 - Len(arr(i, 1)), "0"))
  Next
  ReDim brr(1 To m, 1 To n)
    t = Application.Index(arr, 0, 5)
    For i = 1 To m
      k = Application.Match(Application.Min(t), t, 0)
      For j = 1 To n
        brr(i, j) = arr(k, j)
      Next j
      t(k, 1) = ""
    Next i
  [a2].Resize(UBound(arr), n - 1) = brr
End Sub

yaozong

参考附件  (数组/后台排序)

yaozong

另一变通办法
Sub bb() '单元格排序
  Dim arr, i&, m&, n&
  arr = Range("d2", Cells(Rows.Count, 1).End(3))
  m = UBound(arr): n = UBound(arr, 2)
  For i = 1 To UBound(arr)
    arr(i, 1) = Val(arr(i, 1) & String(9 - Len(arr(i, 1)), "0"))
  Next
  [a2].Resize(m, n) = arr
  [a2].Resize(m, n).Sort [a2], 1
  [a2].Resize(m, n).Replace "000", ""
End Sub

莫悠悠

yaozong 发表于 2014-1-15 12:00
另一变通办法
Sub bb() '单元格排序
  Dim arr, i&, m&, n&

谢谢版主大哥帮忙，请问以上两种办法哪个更好？发现一个问题：当删除一行的时候，不会将空行删除，请问如何解决？

yaozong

莫悠悠 发表于 2014-1-15 13:32
谢谢版主大哥帮忙，请问以上两种办法哪个更好？发现一个问题：当删除一行的时候，不会将空行删除，请问如 ...

中间存在空行时,加一判断
Sub bb() '单元格排序
  Dim arr, i&, m&, n&
  arr = Range("d2", Cells(Rows.Count, 1).End(3))
  m = UBound(arr): n = UBound(arr, 2)
  For i = 1 To UBound(arr)
    If Len(arr(i, 1)) Then arr(i, 1) = Val(arr(i, 1) & String(9 - Len(arr(i, 1)), "0"))
  Next
  [a2].Resize(m, n) = arr
  [a2].Resize(m, n).Sort [a2], 1
  [a2].Resize(m, n).Replace "000", ""
End Sub

莫悠悠

yaozong 发表于 2014-1-15 10:40
参考附件  (数组/后台排序)

请问：数组/后台排序的脚本要怎么改才能实现
当删除一行的时候，会自动将空行删除？

yaozong

arr(i, 5) = Val(arr(i, 1) & String(9 - Len(arr(i, 1)), "0"))

''改为:
    If Len(arr(i, 1)) Then
       arr(i, 5) = Val(arr(i, 1) & String(9 - Len(arr(i, 1)), "0"))
    Else
       arr(i, 5) = 999999999
    End If

莫悠悠

yaozong 发表于 2014-1-15 17:41
arr(i, 5) = Val(arr(i, 1) & String(9 - Len(arr(i, 1)), "0"))

''改为:

非常感谢，得花时间好好研究一下！