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

man65boy

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

¤U¸ü¦¸¼Æ: 12

2017-10-15 21:22

Hsieh

¦^´_ 1# man65boy

1. Private Sub CommandButton1_Click()
   
2. Dim ar()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. 
   
6. For Each sh In Sheets
   
7.   d1(sh.Name) = ""
   
8. Next
   
9. For Each a In Range(Range("I2"), Range("I65536").End(xlUp))
   
10. If d1.exists(a.Value) Then
    
11. If IsEmpty(d(a.Value)) Then
    
12.    ReDim ar(0)
    
13.    ar(0) = a.Offset(, -8).Resize(, 10).Value
    
14.    d(a.Value) = ar
    
15.    Else
    
16.      ar = d(a.Value)
    
17.      i = UBound(ar) + 1
    
18.      ReDim Preserve ar(i)
    
19.      ar(i) = a.Offset(, -8).Resize(, 10).Value
    
20.      d(a.Value) = ar
    
21. End If
    
22. End If
    
23. Next
    
24. For Each ky In d.keys
    
25. k = UBound(d(ky)) + 1
    
26.   Sheets(ky).[A2].Resize(k, 10) = Application.Transpose(Application.Transpose(d(ky)))
    
27. Next
    
28. End Sub

½Æ»s¥N½X

man65boy

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

¤U¸ü¦¸¼Æ: 14

2017-10-16 11:50

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

Hsieh

¦^´_ 3# man65boy

1. Private Sub CommandButton1_Click()
   
2. Dim ar()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. 
   
6. For Each sh In Sheets
   
7.   d1(sh.Name) = ""
   
8. Next
   
9. r = Range("I65536").End(xlUp).Row '¸ê®Æ§À
   
10. For j = r To 2 Step -1
    
11. Set a = Cells(j, "I")
    
12. If d1.exists(a.Value) Then
    
13. If IsEmpty(d(a.Value)) Then
    
14.    ReDim ar(0)
    
15.    ar(0) = a.Offset(, -8).Resize(, 10).Value
    
16.    d(a.Value) = ar
    
17.    Else
    
18.      ar = d(a.Value)
    
19.      i = UBound(ar) + 1
    
20.      ReDim Preserve ar(i)
    
21.      ar(i) = a.Offset(, -8).Resize(, 10).Value
    
22.      d(a.Value) = ar
    
23. End If
    
24. Rows(j).Delete '§R°£¸ê®Æ¦C
    
25. End If
    
26. Next
    
27. For Each ky In d.keys
    
28. k = UBound(d(ky)) + 1
    
29.   Sheets(ky).[A2].Resize(k, 10) = Application.Transpose(Application.Transpose(d(ky)))
    
30. Next
    
31. End Sub

½Æ»s¥N½X

man65boy

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

man65boy

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

¤U¸ü¦¸¼Æ: 15

2017-10-17 10:50

Hsieh

¦^´_ 6# man65boy

1. Private Sub CommandButton1_Click()
   
2. Dim ar()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. 
   
6. For Each sh In Sheets
   
7.   d1(sh.Name) = ""
   
8. Next
   
9. r = Range("I65536").End(xlUp).Row '¸ê®Æ§À
   
10. For j = r To 2 Step -1
    
11. Set a = Cells(j, "I")
    
12. If d1.exists(a.Value) Then
    
13. If IsEmpty(d(a.Value)) Then
    
14.    ReDim ar(0)
    
15.    ar(0) = a.Offset(, -8).Resize(, 10).Value
    
16.    d(a.Value) = ar
    
17.    Else
    
18.      ar = d(a.Value)
    
19.      i = UBound(ar) + 1
    
20.      ReDim Preserve ar(i)
    
21.      ar(i) = a.Offset(, -8).Resize(, 10).Value
    
22.      d(a.Value) = ar
    
23. End If
    
24. Rows(j).Delete '§R°£¸ê®Æ¦C
    
25. End If
    
26. Next
    
27. For Each ky In d.keys
    
28. For i = UBound(d(ky)) To 0 Step -1
    
29.   Sheets(ky).[A65536].End(xlUp).Offset(1, 0).Resize(1, 10) = d(ky)(i)
    
30. Next
    
31. Next
    
32. End Sub

½Æ»s¥N½X

man65boy

¦^´_ 7# Hsieh

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