关于将特定数组倒序排列。求老师指点。

雨田生

如附件，表格A列有用空单元格分隔的若干数组。如何按照要求把相同开端的数组首首相连。

一把小刀闯天下

'假设B列 "中"都是配对出现的（2个），另数据块之间都为一空行。凑了一个，，，

Option Explicit

Sub test()
  Dim arr, i, j, k, kk, m, p
  arr = Range("a2:b" & Cells(Rows.Count, "a").End(xlUp).Row + 2).Value
  ReDim brr(1 To UBound(arr, 1), 1 To 2) As String
  For i = 1 To UBound(arr, 1) - 1
    If arr(i, 2) = "中" Then
      p = i
      For j = p + 1 To UBound(arr, 1) - 1
        If Len(arr(j, 1)) = 0 Then
          Call bsort(arr, p + 1, j - 1, 1, UBound(arr, 2), 1, -1)
          For k = p + 1 To j - 1
            m = m + 1
            brr(m, 1) = arr(k, 1): brr(m, 2) = arr(k, 2)
          Next
          m = m + 1: brr(m, 1) = arr(p, 1): brr(m, 2) = arr(p, 2)
          p = j + 1
          For k = p + 1 To UBound(arr, 1)
            If Len(arr(k, 1)) = 0 Then
              Call bsort(arr, p + 1, k - 1, 1, UBound(arr, 2), 1, 1)
              For kk = p + 1 To k - 1
                m = m + 1
                brr(m, 1) = arr(kk, 1): brr(m, 2) = arr(kk, 2)
              Next
              j = UBound(arr, 1): i = kk: p = kk: m = m + 1: Exit For
            End If
          Next
        End If
      Next
    Else
      If Len(arr(i, 1)) = 0 Then
        Call bsort(arr, p + 1, i - 1, 1, UBound(arr, 2), 1, 1)
        For j = p + 1 To i - 1
          m = m + 1
          brr(m, 1) = arr(j, 1): brr(m, 2) = arr(j, 2)
        Next
        m = m + 1: p = i
      End If
    End If
  Next
  With [j2]
    .Resize(UBound(arr, 1), 2).ClearContents
    .Resize(m, UBound(brr, 2)) = brr
  End With
End Sub

Function bsort(arr, first, last, left, right, key, order As Long)
  Dim i, j, k, t
  For i = first To last - 1
    For j = first To last + first - 1 - i
      If StrComp(arr(j, key), arr(j + 1, key), vbTextCompare) = order Then
        For k = left To right
          t = arr(j, k): arr(j, k) = arr(j + 1, k): arr(j + 1, k) = t
        Next
      End If
    Next
  Next
End Function