vba按区域排序

lpzxhjp

附件的工作表中同年级的行数多少不一样，如何用vba实现每一科分年级分科目按名次从小到大排序，谢谢！效果见附件。谢谢大家！

microyip

把所有数据汇总到一个表内，然后按要求排序一次

lpzxhjp

microyip 发表于 2017-12-1 07:47
把所有数据汇总到一个表内，然后按要求排序一次

就那一个表，我只是取了一部分数据。必须分年级、科目，按名次排序。谢谢

Moneky

短信收到。
这个问题手动也不麻烦，不想写代码了。你又不是天天都要排，是吧。

lpzxhjp

Moneky 发表于 2017-12-1 09:51
短信收到。
这个问题手动也不麻烦，不想写代码了。你又不是天天都要排，是吧。

您好，这个是要做成一个模板共很多人使用，但其中很多人是excel盲，所以这样做。谢谢！

lpzxhjp

自己顶一下！！！大神出现...

duquancai

分年级分科目按名次从小到大排序？？？？
没看见你模拟的数据 是 怎么按照 科目 排序的？

一把小刀闯天下

'下面一个模拟结果的表格删除
Option Explicit

Sub test()
  Dim i, arr, n, t, j, row, a, b, c, tt, k
  ReDim arr(1 To 65536, 1 To 5)
  For i = 1 To 20 Step 5
    n = 1: row = 5: t = Left(Cells(5, i), 2)
    For j = 1 To UBound(arr, 2)
      arr(n, j) = Cells(5, (i - 1) + j)
    Next
    For j = 6 To Cells(65536, i).End(xlUp).row + 1
      If t <> Left(Cells(j, i), 2) Then
        For a = 1 To n - 1
          For b = a + 1 To n
            If Val(arr(a, UBound(arr, 2))) > Val(arr(b, UBound(arr, 2))) Then
              For c = 1 To UBound(arr, 2)
                tt = arr(a, c): arr(a, c) = arr(b, c): arr(b, c) = tt
              Next
            End If
        Next b, a
        Cells(row, i).Resize(n, UBound(arr, 2)) = arr
        t = Left(Cells(j, i), 2): row = j: n = 1
        For k = 1 To UBound(arr, 2)
          arr(n, k) = Cells(row, (i - 1) + k)
        Next
      Else
        n = n + 1
        For k = 1 To UBound(arr, 2)
          arr(n, k) = Cells(j, i - 1 + k)
        Next
      End If
  Next j, i
End Sub

lpzxhjp

duquancai 发表于 2017-12-2 12:35
分年级分科目按名次从小到大排序？？？？
没看见你模拟的数据 是 怎么按照 科目 排序的？

就是每一个学科，分年级按名次排序。即作文中七八九年级分别排序，数学中也是七八九年级分别排序。谢谢！