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

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

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

¤j¤j­Ì :³Ìªñ¦¬¨ìÀɮ׳£¬O¤U­±³o¼Ëªº¦X¨ÖÀx¦s®æ,§Ú´M¨D¹L¸ê®Æ³£¨S¦³±Ð¾Ç¦p¦ó¨ú®ø³o¼ËªºÀx¦s®æ,§Ú¥²¶·¥Îmail¶Çµ¹¦Û¤v«á¦A¶K¨ì·sªº¬¡­¶Ã¯ ¥i¥H¸ò¤j¤j­Ì¨D±Ï¦p¦ó³B²z¶Ü
¦X¨Ö.JPG

¨ú®ø«áÀx¦s®æ

¨ú®ø«áÀx¦s®æ.JPG

¦X¨ÖÀx¦s®æ.rar (7.31 KB)

¨ú®øÀx¦s®æ.rar (9.74 KB)

¦^´_ 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

¦^´_ 2# Hsieh
ÁÂÁ¤j¤jªºÀ°¦£ ¥ß°¨¨Ó¥Î¬Ý¬ÝÁÂÁ§A:)

TOP

¥»©«³Ì«á¥Ñ hu0318s ©ó 2017-9-16 16:48 ½s¿è

¦^´_ 3# hu0318s

dear ¤j¤j:­è­è§Ú¦³½m²ß¥h³B²z,¦b10µ§¥H¤º³£¤ñ¸û¨S°ÝÃD,¦ý¹³§Ú±`±`¦¬¨ìÀɮ׳£¬O¤W¤dµ§,Åܦ¨¦n¹³¥u¦³«e10µ§¥i¥H§¹¦¨ ¨ä¥L³£·|²MªÅ
§Ú¦³½m²ß¥h­×§ï¤F¸Ñ ,¦ý§Úµo²{§Ú¦n·Q·d¯{,¥i¥H½Ð±Ð¤j¤j. ¦b³oÃ䪺offiset §Ú­n¦p¦ó­×§ï¤~¥i¥H§â¸ê®Æ¼g¶iÀx¦s®æ  Cells(r, 1).Offset(, i).Resize(UBound(ay(i)) + 1, 1) = Application.Transpose(ay(i))

§Úªþ¤W§Ú¦¬¨ìªºÀÉ®×

¤U­±¬O
§Ú­×§ïªº
  1. Sub ¨ú®ø´«¦æ()
  2. Dim A As Range, ar()
  3. Set dic = CreateObject("Scripting.Dictionary")
  4. With ActiveSheet
  5. k = .Range(.[A1], .[A1].End(xlDown)).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, 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, i).Resize(UBound(ay(i)) + 1, 1) = Application.Transpose(ay(i))
  21.    Next
  22.    r = r + t
  23. Next
  24. End With
½Æ»s¥N½X
·d¯{ªO.JPG

¦X¨ÖÀx¦s®æ1.rar (923.8 KB)

TOP

        ÀR«ä¦Û¦b : ·R¤£¬O­n¨D¹ï¤è¡A¦Ó¬O­n¥Ñ¦Û¨­ªº¥I¥X¡C
ªð¦^¦Cªí ¤W¤@¥DÃD