遇到一个很复杂的难题。求高手帮忙解决以下，谢谢大家了！

m_n_j001

试试看是不是这个意思：
Sub test()
Dim ar(), br()
ar = Sheets("sheet1").UsedRange.Value
ReDim br(1 To 46, 1 To UBound(ar, 2))
For i% = 1 To UBound(ar, 2)
    br(1, i) = ar(1, i)
Next
r1% = 1
r2% = 1
r3% = 4
i3% = 2
key_now = ar(2, 6)
With Sheets("sheet2")
For i2% = 2 To UBound(ar)
    If key_now = ar(i2, 6) Then
       sum_now = sum_now + ar(i2, 7)
    Else
       r1 = r1 + 1
       br(r1, 6) = "小计"
       br(r1, 7) = sum_now
       If r1 > 23 Then
          .Cells(r3, 2).Resize(r2, 7) = br
          ReDim br(1 To 46, 1 To UBound(ar, 2))
          For i% = 1 To UBound(ar, 2)
              br(1, i) = ar(1, i)
          Next
          r1% = 1
          r2% = 1
          i2 = i3
          r3 = r3 + 27
       ElseIf r1 = 23 Then
             .Cells(r3, 2).Resize(23, 7) = br
             ReDim br(1 To 46, 1 To UBound(ar, 2))
          For i% = 1 To UBound(ar, 2)
              br(1, i) = ar(1, i)
          Next
          r1% = 1
          r2% = 1
          r3 = r3 + 27
       Else
          r2 = r1
          i3 = i2
       End If
       sum_now = ar(i2, 7)
       key_now = ar(i2, 6)
    End If
    r1 = r1 + 1
    For i = 1 To UBound(ar, 2)
        br(r1, i) = ar(i2, i)
    Next
   
Next
If r1 > 1 Then .Cells(r3, 2).Resize(r1, 7) = br
End With
End Sub
拼凑的，没做容错。当参数三的同一个值连续行数超过你黑框能容纳的行数时，程度不能正确运行