Сортировать группы строк

Question

Я на самом деле нашел страницу, на которой, как мне кажется, есть тот же вопрос , но я не понимаю его или того, как я могу применить его к своему приложению.Я думаю, что связанная версия сортируется по группам, вставляя новые строки и вырезая / вставляя строки.К сожалению, у меня пока недостаточно репутации, чтобы комментировать, поэтому я не могу задать исходный вопрос.

Я хочу сделать то же самое, исходя из этого:

К этому:

Мои вопросы - это связанный вопрос, что я на самом деле ищу?Я не вижу, как циклы в предоставленном коде на самом деле сортируют строки.

Answer 1

Сортировка по группам с вертикальным названием.Range, Array, BubbleSort

Отрегулируйте значения 4 в разделе константы , чтобы не потерятьdata.
«Test Checker» blnTest установлен на True, т. е. код находится в Test Mode и будет вставлять отсортированные данные в диапазон, начиная с диапазона ячейки 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