求助求求大神帮帮忙

VBA代码

你这是WPS?先拆分填充合并单元格,然后添加辅助列序号,接着按时间,序号排序,然后在合并相同单元格,最后删除辅助列

Option Explicit
Sub abc()
　Dim a, b, i, j, p
　With Sheets("新(2)")
　　a = .[a1].CurrentRegion.Offset(1).Resize(, 10).Value
　　For i = 1 To UBound(a) - 1
　　　If Len(a(i, 10)) Then p = i Else a(i, 10) = a(p, 10)
　　Next
　　b = a
　　Call msort(a, b, 1, UBound(a) - 1, 1, 10, 10)
　　Call doevent(False)
　　.[l2].Resize(UBound(a) + 1, 10).Clear
　　.[l2].Resize(UBound(a) - 1, 10) = a
　　p = 0
　　For i = 1 To UBound(a) - 1
　　　If Len(a(i + 1, 4)) Or i = UBound(a) - 1 Then
　　　　If i - p > 1 Then
　　　　　For j = 15 To 21
　　　　　　.Cells(p + 2, j).Resize(i - p).Merge
　　　　　Next
　　　　End If
　　　　p = i
　　　End If
　　Next
　　Call doevent(True)
　End With
End Sub
Function doevent(flag As Boolean)
　With Application
　　.DisplayAlerts = flag
　　.ScreenUpdating = flag
　End With
End Function
Function msort(a, temp, first, last, left, right, key)
　Dim i, j, k, kk, mid
　If first <> last Then
　　mid = (first + last) \ 2
　　msort a, temp, first, mid, left, right, key
　　msort a, temp, mid + 1, last, left, right, key
　　i = first: j = mid + 1: k = first
　　While i <= mid And j <= last
　　　If a(i, key) <= a(j, key) Then
　　　　For kk = left To right: temp(k, kk) = a(i, kk): Next
　　　　k = k + 1: i = i + 1
　　　Else
　　　　For kk = left To right: temp(k, kk) = a(j, kk): Next
　　　　k = k + 1: j = j + 1
　　　End If
　　Wend
　　While i <= mid
　　　For kk = left To right: temp(k, kk) = a(i, kk): Next
　　　k = k + 1: i = i + 1
　　Wend
　　While j <= last
　　　For kk = left To right: temp(k, kk) = a(j, kk): Next
　　　k = k + 1: j = j + 1
　　Wend
　　For i = first To last
　　　For j = left To right
　　　　a(i, j) = temp(i, j)
　　Next j, i
　End If
End Function

文件发我 我给你做