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

³o¼Ëªº¦X¨ÖÀx¦s®æ¦p¦ó¨ú®ø

¦^´_ 1# hu0318s
°ò¥»¾Þ§@¤ñ¸ûÁcÂø
¥ÎVBA»²§U§a
  1. Sub ¨ú®ø´«¦æ()
  2. Dim A As Range, ar()
  3. Set dic = CreateObject("Scripting.Dictionary")
  4. With ActiveSheet
  5. k = .Range(.[A1], .[A1].End(xlToRight)).Count
  6. For Each A In .Columns("A:A").SpecialCells(xlCellTypeConstants)
  7. ReDim ar(k)
  8.   For i = 0 To k - 1
  9.      ar(i) = Split(A.Offset(, i), Chr(10))
  10.   Next
  11.   dic(A.Value) = ar
  12.   Erase ar
  13. Next
  14. .Cells.ClearContents
  15. r = 1: t = 1
  16. For Each ky In dic.keys
  17.    For i = 0 To k - 1
  18.    ay = dic(ky)
  19.    t = IIf(UBound(ay(i)) + 1 > t, UBound(ay(i)) + 1, t)
  20.    .Cells(r, 1).Offset(, i).Resize(UBound(ay(i)) + 1, 1) = Application.Transpose(ay(i))
  21.    Next
  22.    r = r + t
  23. Next
  24. End With
  25. End Sub
½Æ»s¥N½X
¦X¨ÖÀx¦s®æ.zip (21.53 KB)
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

        ÀR«ä¦Û¦b : §ïÅܦۤv¬O¦Û±Ï¡A¼vÅT§O¤H¬O±Ï¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD