对行组进行排序

Question

我实际上found a page that I think has the same question，但是我无法理解它或如何将其应用于我的应用程序。我认为链接版本通过插入新行和剪切/粘贴行来对分组进行排序。不幸的是，我没有足够的声誉来发表评论，所以我不能问原始的问题。

我想从这开始做同样的事情：

对此：

我的问题是链接的问题实际上是我想要的吗？我看不到提供的代码中的循环实际上如何对行进行排序。

Answer 1

排序垂直标题的组专长。范围，数组，BubbleSort

仔细调整常量部分中的 4 值，以免丢失数据。
“测试检查器” blnTest设置为True，即代码处于测试模式中，并将已排序的数据粘贴到以cStrFirstTest单元格开头的范围内范围。如果您将blnTest更改为False，则初始数据将被替换，即，已排序的数据将被粘贴到以cStrFirstCell单元格范围开始的范围内，如请求。

Option Explicit

Sub SortVerticalGroups()

  Const cStrFirstCell As String = "A2"  ' First Cell Range of Data
  Const intLastColumn As Integer = 3    ' Last Column of Data
  Const cStrFirstTest As String = "D2"  ' Test First Cell Range of Data
  Const blnTest As Boolean = True       ' Test Checker

  Dim vntData As Variant    ' Data Array
  Dim vntGroup As Variant   ' Group Array
  Dim vntSort As Variant    ' Sort Array

  Dim lngR1 As Long         ' Data Array Rows & Sort Outer Counter
  Dim lngR2 As Long         ' Group Count, Group Array Rows & Sort Inner Counter
  Dim lngR3 As Long         ' Sort Array Rows Counter
  Dim iCol As Integer       ' Data Array & Sort Array Columns Counter
  Dim iTemp As Integer      ' Sort Temporary Data Storage
  Dim strRange As String    ' Sort Range's First Cell

  ' Paste range into array.
  With ThisWorkbook.ActiveSheet
    vntData = .Range( _
        cStrFirstCell, _
        Cells( _
          .Range(.Range(cStrFirstCell), Cells(Rows.Count, intLastColumn)) _
            .Find(What:="*", _
            After:=.Range(cStrFirstCell), LookIn:=xlFormulas, _
            Lookat:=xlWhole, SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious).Row, _
          intLastColumn))
  End With

  ' Count the number of Groups.
  For lngR1 = 1 To UBound(vntData)
    If vntData(lngR1, 1) <> "" Then
      lngR2 = lngR2 + 1
    End If
  Next

  ' Write groups to Group Array.
  ReDim vntGroup(1 To lngR2, 1 To 1)
  lngR2 = 0
  For lngR1 = 1 To UBound(vntData)
    If vntData(lngR1, 1) <> "" Then
      lngR2 = lngR2 + 1
      vntGroup(lngR2, 1) = vntData(lngR1, 1)
    End If
  Next

  ' Sort Group Array.
  For lngR1 = 1 To UBound(vntGroup) - 1
    For lngR2 = lngR1 + 1 To UBound(vntGroup)
      If vntGroup(lngR1, 1) > vntGroup(lngR2, 1) Then
        iTemp = vntGroup(lngR1, 1)
        vntGroup(lngR1, 1) = vntGroup(lngR2, 1)
        vntGroup(lngR2, 1) = iTemp
      End If
    Next
  Next

  ' Write sorted data to Sort Array.
  ReDim vntSort(1 To UBound(vntData), 1 To UBound(vntData, 2))
  For lngR2 = 1 To UBound(vntGroup)
    For lngR1 = 1 To UBound(vntData)
      If vntData(lngR1, 1) = vntGroup(lngR2, 1) Then
        Do
          lngR3 = lngR3 + 1
          For iCol = 1 To UBound(vntData, 2)
            vntSort(lngR3, iCol) = vntData(lngR1, iCol)
          Next
          lngR1 = lngR1 + 1
          If lngR1 > UBound(vntData) Then Exit Do
        Loop Until vntData(lngR1, 1) <> ""
      End If
    Next
  Next

  ' Check if test or for real.
  If blnTest Then
    strRange = cStrFirstTest
   Else
    strRange = cStrFirstCell
  End If

  ' Paste Sort Array into range.
  With ThisWorkbook.ActiveSheet
      .Range(strRange).Resize(UBound(vntSort), UBound(vntSort, 2)) = vntSort
  End With

End Sub