关于聊天记录时间排序

tom24310

小白求助大神一个问题

例如，我从QQ群聊里粘贴了某个人的发的聊天记录，但是存在几个问题解决。

第一，聊天记录的时间是从最晚发言到最早发言排序，我想把聊天记录排列成最早发言到最晚发言的时间序列；

第二，这样排列的话，不仅时间要对，在时间下面的聊天记录也要跟着一起排列；

第三，有的时间点下的聊天记录不止1行，可能有2行，3行等；

还请大神解决。

左边是原始数据，右边是期望达到的效果（时间从早到晚，然后每一个时间点下的数据都能在正确的时间点下）

原始：

希望达成的效果：
求助 - 副本.rar (7.89 KB, 下载次数: 9)

2020-3-17 02:04 上传

点击文件名下载附件

求助excel在附件中

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, crr, i, j, k, m, t, p, s, cnt
  arr = Range("a1:a" & Cells(Rows.Count, "a").End(xlUp).Row + 1)
  ReDim brr(1 To UBound(arr, 1), 1 To 3)
  crr = arr
  For i = 1 To UBound(arr, 1)
    If Len(arr(i, 1)) = 0 Then
      m = m + 1: t = Split(arr(p + 1, 1), ChrW(160))
      If InStr(arr(p + 1, 1), "上午") Then s = "AM" Else s = "PM"
      brr(m, 1) = CDate(t(1)) + CDate(t(4) & Space(1) & s)
      brr(m, 2) = p + 1: brr(m, 3) = i
      p = i
    End If
  Next
  For i = 1 To m - 1
    For j = i + 1 To m
      If brr(i, 1) > brr(j, 1) Then
        For k = 1 To UBound(brr, 2)
          t = brr(i, k): brr(i, k) = brr(j, k): brr(j, k) = t
        Next
      End If
    Next
  Next
  For i = 1 To m
    For j = brr(i, 2) To brr(i, 3)
      cnt = cnt + 1: arr(cnt, 1) = crr(j, 1)
    Next
  Next
  With [n1]
    .Resize(UBound(arr, 1) * 2).ClearContents
    .Resize(cnt) = arr
  End With
End Sub

山菊花

供参考。

一把小刀闯天下

'如果只是反向输出可以这样，前面的支持无序，，，

Option Explicit

Sub test()
  Dim arr, brr, i, j, m, n, p
  arr = Range("a1:a" & Cells(Rows.Count, "a").End(xlUp).Row + 1)
  brr = arr: p = UBound(arr, 1)
  For i = UBound(arr, 1) - 1 To 1 Step -1
    If Len(arr(i, 1)) = 0 Or i = 1 Then
      If i = 1 Then n = 1 Else n = i + 1
      For j = n To p
        m = m + 1
        brr(m, 1) = arr(j, 1)
      Next
      p = i
    End If
  Next
  [n1].Resize(m) = brr
End Sub

FOB_FN_L

@ggmmlol  
GGM神，来个正则的解法学习下，这个贴子。这个是个有代表性的一类问题了

asdfasdf3546

大哥们的答案好简洁,认真学习学习,我来混分