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

[µo°Ý] ±N«ü©wÄæ¦ì¤º¦³¸ê®Æªº³¡¥÷,·h²¾´¡¤J¨ì«ü©w¦C

[µo°Ý] ±N«ü©wÄæ¦ì¤º¦³¸ê®Æªº³¡¥÷,·h²¾´¡¤J¨ì«ü©w¦C

¥»©«³Ì«á¥Ñ marklos ©ó 2012-5-12 12:27 ½s¿è

(Sheet1)«Ý³B²z¤u§@ªí


(Sheet2)³B²z«á
±NDÄæ¦ì¤º , ¦³¸ê®ÆªºÀx¦s®æ·h²¾¨ì¤U¤@¦CCÄ檺¦ì¸m,¸Ó¦C¦ì¸m¸óÄæ¸m¤¤ , ¨Ã§R°£DÄæ~


·PÁÂ~~

QQ.rar (5.65 KB)

¦^´_ 2# act09132


   ³o¦ì¤¯¥S ·Q­n¦³Åv­­¤]¤£¬O³o¼Ë¬~ª©ªº§a?

TOP

¦^´_ 1# marklos
  1. Sub xx()
  2. For d = [a1].End(xlDown).Row To 2 Step -1
  3.   If Cells(d, 4) <> "" Then
  4.      Rows(d + 1).Insert
  5.      Cells(d, 4).Copy Cells(d + 1, 3)
  6.      For i = 1 To 10
  7.        If Cells(d + 1, i) = "" Then Range(Cells(d + 1, i), Cells(d, i)).Merge
  8.      Next i
  9.   End If
  10. Next d
  11. Columns(4).Delete
  12. End Sub
½Æ»s¥N½X

TOP

¦^´_ 3# register313


    ·PÁ±zªºÀ°¦£~~ÁÂÁÂ!

TOP

¦^´_ 3# register313

    ·PÁ±z¤W¦¸ªºÀ°¦£~ ¦]¬°»Ý¨D¥\¯à¦³¨Ç³\Åܧó  , Áٽм·±±À°¦£¤@¤U ...
(Sheet1)Äò¤W¦¸ªº°ÝÃD , «Ý³B²z¤u§@ªí¤º¦h¤FEÄæ¦ì "PN2"

(Sheet2)³B²z«á
±NDÄæ¦ì¥H¤ÎEÄ椺 , ¦³¸ê®ÆªºÀx¦s®æ¨Ì·Ó¶¶§Ç´¡¤J¦ÜCÄ檺¤U¤@¦C¦ì¸m, ¥B¸Ó¦C¨ä¥LÄæ¦ì§¡½Æ»s¤W¤@¦Cªº¸ê®Æ , ¨Ã§R°£DÄæ»PEÄæ~


ªþ¥ó
Excel-Q5.rar (6.34 KB)

2012-06-06_093443.jpg (91.38 KB)

2012-06-06_093443.jpg

TOP

¥»©«³Ì«á¥Ñ register313 ©ó 2012-6-6 13:04 ½s¿è

¦^´_ 5# marklos
  1. Sub xx()
  2. Sheets("sheet1").Cells.Copy Sheets("sheet2").[A1]
  3. Sheets("sheet2").Select
  4. For d = [A1].End(xlDown).Row To 2 Step -1
  5.   c = Application.CountA(Cells(d, 4).Resize(1, 2))
  6.   If Cells(d, 4) <> "" Then
  7.      Rows(d).Copy
  8.      Rows(d + 1).Resize(c).Insert Shift:=xlDown
  9.      Cells(d + 1, 3).Resize(c, 1) = Application.Transpose(Cells(d, 4).Resize(1, 2))
  10.   End If
  11. Next d
  12. Columns("d:e").Delete
  13. End Sub
½Æ»s¥N½X
  1. Sub yy()
  2. Set d = CreateObject("scripting.dictionary")
  3. With Sheets("sheet1")
  4.   For i = 2 To .[A1].End(xlDown).Row
  5.     Ar = .Range(.Cells(i, "A"), .Cells(i, "K"))
  6.     d(.Cells(i, 3).Value) = Ar
  7.     For j = 4 To 5
  8.       If .Cells(i, j) <> "" Then
  9.         Ar(1, 3) = .Cells(i, j)
  10.         d(.Cells(i, j).Value) = Ar
  11.       End If
  12.     Next j
  13.   Next i
  14. End With
  15. With Sheets("sheet2")
  16.   .Cells = ""
  17.   Sheets("sheet1").Rows(1).Copy .[A1]
  18.   .[A2].Resize(d.Count, 11) = Application.Transpose(Application.Transpose(d.items))
  19.   .Columns("D:E").Delete
  20.   .[A1].CurrentRegion.Borders.LineStyle = xlContinuous
  21. End With
  22. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : ÁÀ¨¥¹³¤@¦·²±¶}ªºÂAªá¡A¥~ªí¬üÄR¡A¥Í©Rµu¼È¡C
ªð¦^¦Cªí ¤W¤@¥DÃD