ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¸ê®ÆÂର«ü©wÄæ¼Æ ¶W¥X«ü©w¼Æ«h¼g¤J¤U¤@¦C

[µo°Ý] ¸ê®ÆÂର«ü©wÄæ¼Æ ¶W¥X«ü©w¼Æ«h¼g¤J¤U¤@¦C

¦p¤U¹Ï©Ò¥Ü ¦]­n±N¸ê®Æ¿é¥X,¤w¹w¥ýÂର¦¹®æ¦¡
¦ýÅܦ¨Äæ¼Æ¤Ó¦h µLªk¿é¥X

·Q½Ð°Ý¥i§_°µ¨ì»¡
«ü©wÂà´«¨ì5Ä椧«á ¸õ¦Ü¤U¤@¦CÄ~Äò¼g¤J©O?
¦h¦CÂà«ü©wÄæ¼Æ,¶W¥X¤U¤@¦C.rar (14.42 KB)

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

TOP

¦^´_ 2# ­ã´£³¡ªL


    ·PÁ ­ã¤j¥X¤â¡I¡I¡I

TOP

¥»©«³Ì«á¥Ñ starry1314 ©ó 2018-11-23 15:03 ½s¿è

¦^´_ 2# ­ã´£³¡ªL

¶q¦hµLªk°õ¦æ_¦h¦CÂà«ü©wÄæ¼Æ,¶W¥X¤U¤@¦C.rar (39.71 KB)
    ²a¤j ¤£¦n·N«ä
³o¬O§_¦³­­¨î©O?

Brr(N, 1) °}¦C¯Á¤Þ¶W¥X½d³ò

¤j¬ù¦ì©ó975´N·|°±¾nµLªk¨Ï¥Î

TOP

¦^´_ 4# starry1314


    ½Õ¾ã¤F ¦n¹³¬O¥X¦b³o
­ì©l--> ReDim Brr(1 To UBound(Arr), 1 To 7)
¦C¼Æ¤p©óÂà´««á·|¨Ï¥Î¨ìªº¦C¼Æ

§ó§ï«á---> ReDim Brr(1 To 5000, 1 To 7)
¥i¦¨¥\°õ¦æ
¦ý´N¨S¦³°ÊºA½d³ò¤F

TOP

¦^´_ 5# starry1314


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

TOP

        ÀR«ä¦Û¦b : ¤p¨Æ¤£°µ¡B¤j¨ÆÃø¦¨¡C
ªð¦^¦Cªí ¤W¤@¥DÃD