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

[µo°Ý] ¦p¦ó§â¸ê®ÆÂà¼g¨ì¹ïÀ³ªº¤u§@ªí

[µo°Ý] ¦p¦ó§â¸ê®ÆÂà¼g¨ì¹ïÀ³ªº¤u§@ªí

½Ð±Ð¦U¦ì¦Ñ®v­Ì¡A­n¦p¦ó§âIÄæ¤ÀÃþ¤¤ªº¸ê®ÆA~JÄæ¾ã¦Cªº¸ê®ÆÂà¼g¨ì¹ïÀ³ªº¤u§@ªí¤¤¡AÀµ¨D¦Ñ®v­ÌªºÀ°¦£¡C
ªþÀÉ: 20171015.rar (7.23 KB)

¦^´_ 1# man65boy
  1. Private Sub CommandButton1_Click()
  2. Dim ar()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Set d1 = CreateObject("Scripting.Dictionary")

  5. For Each sh In Sheets
  6.   d1(sh.Name) = ""
  7. Next
  8. For Each a In Range(Range("I2"), Range("I65536").End(xlUp))
  9. If d1.exists(a.Value) Then
  10. If IsEmpty(d(a.Value)) Then
  11.    ReDim ar(0)
  12.    ar(0) = a.Offset(, -8).Resize(, 10).Value
  13.    d(a.Value) = ar
  14.    Else
  15.      ar = d(a.Value)
  16.      i = UBound(ar) + 1
  17.      ReDim Preserve ar(i)
  18.      ar(i) = a.Offset(, -8).Resize(, 10).Value
  19.      d(a.Value) = ar
  20. End If
  21. End If
  22. Next
  23. For Each ky In d.keys
  24. k = UBound(d(ky)) + 1
  25.   Sheets(ky).[A2].Resize(k, 10) = Application.Transpose(Application.Transpose(d(ky)))
  26. Next
  27. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 2# Hsieh
ÁÂÁÂHsiehªº¦^ÂСA¤p§Ìµo°Ý¤£°÷©ú½T¡A©ç¨Æ¡A©Ò¥HÁÙ­n¦A­×§ï¡A(¨ÌÃþ§O¿ï«á¡A¦bÂà¼g¨ì¹ïÀ³ªº¤u§@ªí«á¡A¤£¯dÂà¼g«áªº¸ê®Æ¦b·í«eªº¤u§@ªí¤W¡C
PS:¸ê®ÆÂà¼g«á¡A¦A¨Ì§Ç±Æ¦C¡A¤£¯dªÅ¥Õ³B¡C)¸Ô²Ó»Ý¨D¦b¨C­Ó¤u§@ªí¤W¦³±Ô­z¡AªþÀÉ ¤u§@¬ö¿ý2.rar (18.68 KB)

    ÁÂÁ¦ѮvªºÀ°¦£^^

TOP

¦^´_ 3# man65boy
  1. Private Sub CommandButton1_Click()
  2. Dim ar()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Set d1 = CreateObject("Scripting.Dictionary")

  5. For Each sh In Sheets
  6.   d1(sh.Name) = ""
  7. Next
  8. r = Range("I65536").End(xlUp).Row '¸ê®Æ§À
  9. For j = r To 2 Step -1
  10. Set a = Cells(j, "I")
  11. If d1.exists(a.Value) Then
  12. If IsEmpty(d(a.Value)) Then
  13.    ReDim ar(0)
  14.    ar(0) = a.Offset(, -8).Resize(, 10).Value
  15.    d(a.Value) = ar
  16.    Else
  17.      ar = d(a.Value)
  18.      i = UBound(ar) + 1
  19.      ReDim Preserve ar(i)
  20.      ar(i) = a.Offset(, -8).Resize(, 10).Value
  21.      d(a.Value) = ar
  22. End If
  23. Rows(j).Delete '§R°£¸ê®Æ¦C
  24. End If
  25. Next
  26. For Each ky In d.keys
  27. k = UBound(d(ky)) + 1
  28.   Sheets(ky).[A2].Resize(k, 10) = Application.Transpose(Application.Transpose(d(ky)))
  29. Next
  30. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 4# Hsieh
ÁÂÁ¦Ѯvªº¦^µª¡A¦bÁ`ªíªº°ÝÃDÂà¼g¨S°ÝÃD¡A¦ý¬O¦b§âÁ`ªíªº¸ê®ÆÂà¥X¨ì¨ä¥L¤u§@ªí®É¡A·|¥X²{Âл\¡A¨S¨Ì§Ç©¹¤U±Æ¦C¡A²³æ¨Ó»¡¡AÁ`ªíÂà¼g¥X¥h«á¡A·|¦b¤£©w®Éªº§@·~¡A¦AÂà¼g¥X¥h¡A©Ò¥H¸ê®Æ¨ì¨ä¥L¤u§@ªí¤W¡A¤£¯à¦³Âл\ªº°Ê§@¡A¥u¯à¨Ì±Æ¦C¤è¦¡©¹¤U¡A¦A³Â·Ð¦Ñ®v¤F^^

TOP

¦^´_ 4# Hsieh
¤p§Ì¤§«e¦³µo°Ý¹L¤@­Ó°ÝÃD¡A´N¬O¦b³o¤u§@ªí¤Wªº¥\¯à©Ê¦bªu¤É¡A¦h¤F§â¿ï¾ÜªºÃþ§O¡AÂà¨ì«ü©wªº¤u§@ªí¤W¨Ì§Ç±Æ¦C¡Aªþ¤W¤§«eµo°ÝªºÀɮװѦÒ: ¥H¯S©w¦r¤¸¾ã¦C¸ê®ÆÂà¼g.rar (9.09 KB)

TOP

¦^´_ 6# man65boy
  1. Private Sub CommandButton1_Click()
  2. Dim ar()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Set d1 = CreateObject("Scripting.Dictionary")

  5. For Each sh In Sheets
  6.   d1(sh.Name) = ""
  7. Next
  8. r = Range("I65536").End(xlUp).Row '¸ê®Æ§À
  9. For j = r To 2 Step -1
  10. Set a = Cells(j, "I")
  11. If d1.exists(a.Value) Then
  12. If IsEmpty(d(a.Value)) Then
  13.    ReDim ar(0)
  14.    ar(0) = a.Offset(, -8).Resize(, 10).Value
  15.    d(a.Value) = ar
  16.    Else
  17.      ar = d(a.Value)
  18.      i = UBound(ar) + 1
  19.      ReDim Preserve ar(i)
  20.      ar(i) = a.Offset(, -8).Resize(, 10).Value
  21.      d(a.Value) = ar
  22. End If
  23. Rows(j).Delete '§R°£¸ê®Æ¦C
  24. End If
  25. Next
  26. For Each ky In d.keys
  27. For i = UBound(d(ky)) To 0 Step -1
  28.   Sheets(ky).[A65536].End(xlUp).Offset(1, 0).Resize(1, 10) = d(ky)(i)
  29. Next
  30. Next
  31. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 7# Hsieh

ÁÂÁÂHsieh ¦Ñ®vªºÀ°¦£¸Ñµª¡A·P¿E¤£ºÉ!^^

TOP

        ÀR«ä¦Û¦b : ¦³®É·í«äµL®É­W¡A¦n¤Ñ­n¿n«B¨Ó³¡C
ªð¦^¦Cªí ¤W¤@¥DÃD