­ã´£³¡ªL

Sub ¶×¤J()
Dim Arr, Brr, i&, j%, N&, C%, xR As Range, xH As Range
Sheets("Âà´««á").UsedRange.Offset(1, 0).EntireRow.Delete
Arr = Sheets("­ì©l¸ê®Æ").UsedRange
ReDim Brr(1 To UBound(Arr), 1 To 7)
For i = 2 To UBound(Arr)
    If Arr(i, 1) = "" Then GoTo 101
    N = N + 1: C = 2
    Brr(N, 1) = Arr(i, 1): Brr(N, 2) = Arr(i, 2)
    For j = 3 To UBound(Arr, 2)
        If C = 7 Then N = N + 1: C = 2
        If Arr(i, j) <> "" Then C = C + 1: Brr(N, C) = Arr(i, j)
    Next j
101: Next i
If N = 0 Then Exit Sub
With [Âà´««á!A2].Resize(N, 7)
     .Value = Brr
     For Each xR In .Columns(1).Cells
         If xR <> "" Then Set xH = xR
         If xR(2) <> "" Or xR.Row = N + 1 Then
            Range(xR, xH).Merge
            Range(xR(1, 2), xH(1, 2)).Merge
         End If
     Next
     .Borders.LineStyle = 1
End With
End Sub

­ã´£³¡ªL

¦^´_ 5# starry1314


§Ñ¤F¶×¤J¦C¼Æ·|¤j¤_¸ê®Æ¦C¼Æ,
¥Î 1 to 5000 ©Î§ó¤j¨Ç³£¥i¥H~~