½Ð±Ð¦p¦ó¿z¿ï¦C¥X¤£«ÂÐ¸ê®Æ¨Ã¥[Á`¼Æ¶q
| ©«¤l129 ¥DÃD47 ºëµØ0 ¿n¤À206 ÂI¦W0  §@·~¨t²Î7 ³nÅ骩¥»2007 ¾\ŪÅv20 ©Ê§O¨k µù¥U®É¶¡2011-8-10 ³Ì«áµn¿ý2024-8-14 
 | 
 ½Ð±Ð¦p¦ó¿z¿ï¦C¥X¤£«ÂÐ¸ê®Æ¨Ã¥[Á`¼Æ¶q
| ½Ð±Ð¦p¦ó¿z¿ï¦C¥X¤£«ÂÐ¸ê®Æ¨Ã¥[Á`¼Æ¶q, ¦pªþ¥ó 
 A¡BBÄæ¬°ì©l¸ê®Æ
 1) ¦p¦ó¨Ï¥Î¨ç¼Æ©ÎVBA±N F Äæ¿z¿ï¦C¥X A Äæ¤£«ÂÐ¸ê®Æ
 2) G Äæ¦Û°Ê¥[Á`²Å¦X F Äæ¦ì±ø¥óªº¼Æ¶q ( ¼Æ¶q¨Ó·½¬° B Äæ)
 
 
  sheet.rar (8.08 KB) 
 
     | 
 | 
|  | 
|  |  | 
|  |  | 
| ©«¤l129 ¥DÃD47 ºëµØ0 ¿n¤À206 ÂI¦W0  §@·~¨t²Î7 ³nÅ骩¥»2007 ¾\ŪÅv20 ©Ê§O¨k µù¥U®É¶¡2011-8-10 ³Ì«áµn¿ý2024-8-14 
 | 
                
| ¤£¦n·N«ä, §ó¥¿«·sµo°Ý 
 ½Ð±Ð«ö¶s vba ¦p¦ó¼g?
 1) ½Æ»s data ¸ê®Æªí¤º "¤£«ÂÐ" ªº®Æ¥ó¥N¸¹¦Ü sheet1 AÄæ¦ì
 2) pºâ¥[Á` data ¸ê®Æªí¤º®Æ¥ó¥N¸¹©Ò¹ïÀ³ªºÀ³µo¼Æ¶q =  sheet1 ®Æ¥ó¥N¸¹
 
 
  data.rar (14.27 KB) | 
 | 
|  | 
|  |  | 
|  |  | 
| ©«¤l2843 ¥DÃD10 ºëµØ0 ¿n¤À2899 ÂI¦W0  §@·~¨t²Î¡e²¤¡f ³nÅ骩¥»¡e²¤¡f ¾\ŪÅv100 ©Ê§O¨k ¨Ó¦Û¡e²¤¡f µù¥U®É¶¡2013-5-13 ³Ì«áµn¿ý2025-10-18 
 | 
                
| Sub update() Dim Arr, xD, T$, i&, U&, S, N&
 [sheet1!A:B].ClearContents
 Arr = Range([data!B1], [data!A65536].End(xlUp))
 Set xD = CreateObject("Scripting.Dictionary")
 For i = 2 To UBound(Arr)
 T = Arr(i, 1):  If T = "" Then GoTo 101
 U = xD(T): S = Val(Arr(i, 2))
 If U = 0 Then
 N = N + 1:   U = N:   xD(T) = N
 Arr(U + 1, 1) = T:    Arr(U + 1, 2) = 0
 End If
 Arr(U + 1, 2) = Arr(U + 1, 2) + S
 101: Next
 If N = 0 Then Exit Sub
 With [sheet1!A1:B1].Resize(N + 1)
 .Columns(1).NumberFormatLocal = "@"
 .Value = Arr
 End With
 End Sub
 
 ================================
 | 
 | 
|  | 
|  |  | 
|  |  | 
| ©«¤l1515 ¥DÃD40 ºëµØ0 ¿n¤À1539 ÂI¦W0  §@·~¨t²ÎWindows  7 ³nÅ骩¥»Excel 2010 & 2016 ¾\ŪÅv100 ©Ê§O¨k ¨Ó¦Û¥xÆW µù¥U®É¶¡2020-7-15 ³Ì«áµn¿ý2025-10-31 
 | 
                
| ¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-6-2 07:53 ½s¿è 
 ¦^´_ 3# ã´£³¡ªL
 
 
 ÁÂÁ½׾Â,ÁÂÁ«e½ú
 «á¾ÇÂǦ¹©«¾Ç²ß«e½úªº¤è®×,¤è®×¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É
 
 °õ¦æ«e:
 
     
 °õ¦æµ²ªG:
 
     
 
 Sub update()
 Dim Arr, xD, T$, i&, U&, S, N&
 '¡ô«Å§iÅܼÆ
 [sheet1!A:B].ClearContents
 '¡ô¥Oµ²ªGªíA~BÄæ²M°£¤º®e
 Arr = Range([data!B1], [data!A65536].End(xlUp))
 '¡ô¥OArrÅܼƬO ¤Gºû°}¦C,¥HdateªíA~BÄæ¸ê®Æ±a¤J°}¦C¤¤
 Set xD = CreateObject("Scripting.Dictionary")
 '¡ô¥OxDÅܼƬO ¦r¨å
 For i = 2 To UBound(Arr)
 '¡ô³]¶¶°j°é
 T = Arr(i, 1):  If T = "" Then GoTo 101
 '¡ô¥OTÅܼƬO°}¦C²Ä1Äæ¦r¦êÈ;¦pªGTÅܼƬOªÅ¦r¤¸,´N¸õ¨ì101¦ì¸mÄ~Äò°õ¦æ
 U = xD(T): S = Val(Arr(i, 2))
 '¡ô¥OUÅܼƬO ¥HTÅܼƬdxD¦r¨å¦^¶Çitem,¥OSÅܼƬO °}¦C²Ä2ÄæÈÂà¼ÆÈ
 If U = 0 Then
 '¡ô¦pªGUÅܼƬO0?
 N = N + 1:   U = N:   xD(T) = N
 '¡ô¥ONÅܼƲ֥[1(²Öpµ²ªG¸ê®Æ³Ì«á¦C¸¹),¥OUÅܼƬONÅܼÆÈ,
 '¥OTÅܼƷíkey,item¬ONÅܼÆ(¥O¦r¨åÀ°°O¦íµ²ªG®Æ¥ó¥N¸¹¦bþ¤@¦Cªº¤U¤@¦C?)
 Arr(U + 1, 1) = T:    Arr(U + 1, 2) = 0
 '¡ô¥OU+1¦C²Ä1ÄæArr°}¦CȬO TÅܼÆ(®Æ¥ó¥N¸¹)
 '¡ô¥OU+1¦C²Ä2ÄæArr°}¦CȬO 0 (¦]¬°¥Î¦P¤@°}¦C¼g¤Jµ²ªG¸ê®Æ!¥ýÂk¹s)
 '(U+1¬O¬°¤F«O¯d¼ÐÃD¦C)
 End If
 Arr(U + 1, 2) = Arr(U + 1, 2) + S
 '¡ô¥OU+1¦C²Ä2ÄæArr°}¦CȲ֥[ SÅܼÆ(À³µo¼Æ¶q)
 101: Next
 If N = 0 Then Exit Sub
 '¡ô¦pªGNÅܼÆ(¨S¦³«½Æªº ®Æ¥ó¥N¸¹),´Nµ²§ôµ{¦¡°õ¦æ
 With [sheet1!A1:B1].Resize(N + 1)
 '¡ô¥H¤U¬Oªí1±q[A1:B1]¶}©l¦V¤UÂX®i(N+1)¦CªºÀx¦s®æ½d³ò,Ãö©ó³o½d³òµ{§Ç
 .Columns(1).NumberFormatLocal = "@"
 '¡ô¥O³o½d³òªº²Ä1ÄæÀx¦s®æ®æ¦¡¬O¤å¦r
 .Value = Arr
 '¡ô¥O³o½d³òÀx¦s®æÈ¬OArr°}¦CÈ,¶W¹L³o½d³òªº°}¦CÈ©¿²¤
 End With
 End Sub
 | 
 | 
| ¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
 | 
|  |  | 
|  |  | 
| ©«¤l1515 ¥DÃD40 ºëµØ0 ¿n¤À1539 ÂI¦W0  §@·~¨t²ÎWindows  7 ³nÅ骩¥»Excel 2010 & 2016 ¾\ŪÅv100 ©Ê§O¨k ¨Ó¦Û¥xÆW µù¥U®É¶¡2020-7-15 ³Ì«áµn¿ý2025-10-31 
 | 
                
| ¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-6-2 08:58 ½s¿è 
 ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
 «á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¨Ï¥Î2Ó°}¦C¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
 
 
 Option Explicit
 Sub TEST()
 Dim Brr, Crr, Y, R&, i&, T1$, T2$, K&
 Dim xRd As Range, Shd As Worksheet, Sha As Worksheet
 '¡ô«Å§iÅܼÆ
 Set Y = CreateObject("Scripting.Dictionary")
 '¡ô¥OYÅܼƬO ¦r¨å
 Set Shd = Sheets("data"): Set Sha = Sheets("sheet1"): Sha.[A:B].ClearContents
 '¡ô¥OÅܼƸˤJª«¥ó(¤u§@ªí),¥Oµ²ªGªí²M°£ÂÂ¸ê®Æ
 Set xRd = Range(Shd.[B1], Shd.Cells(Rows.Count, 1).End(xlUp))
 '¡ô¥OxRdÅܼƸˤJª«¥ó(¸ê®ÆªíA~BÄæÀx¦s®æ)
 Brr = xRd: K = UBound(Brr): ReDim Crr(1 To K, 1 To 2)
 '¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HxRdÅܼÆÈ±a¤J°}¦C¤¤,
 '¥OKÅܼƬOBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹,
 '¥OCrrÅܼƬO ¤GºûªÅ°}¦C,«Å§i¥Lªº½d³òÁa¦V¦PBrr°}¦C,¾î¦V1~2¯Á¤Þ¸¹
 For i = 1 To K
 '¡ô³]¶¶°j°é
 T1 = Brr(i, 1): T2 = Brr(i, 2)
 '¡ô¥OÅܼƸˤJ°}¦CÈ,¦¨¬°¦r¦êÅܼÆ
 If i = 1 Then R = R + 1: Crr(i, 1) = T1: Crr(i, 2) = T2: GoTo i01
 '¡ô¦pªGi°j°é¬O 1!´N¥OR¬O0+1,¥OCrr°}¦C¼ÐÃD¦C¦PBrr°}¦C,¥O¸õ¨ìi01¦ì¸mÄ~Äò°õ¦æ
 If Y(T1) = "" Then R = R + 1: Y(T1) = R: Crr(R, 1) = T1
 '¡ô¦pªG¥HT1ÅܼƬdY¦r¨å¦^¶Çitem¬OªÅ¦r¤¸(ªì¦¸¯Ç¤J¦r¨å),´N¥ORÅܼÆ+1(²Öp¦C¸¹)
 '¥O¦bY¦r¨å¤¤key¬O T1Åܼƪºitem´«¦¨¬O RÅܼÆ(°O¦í ®Æ¥ó¥N¸¹¬O©ñ¦bCrrþ¤@¦C)
 '¥OCrr°}¦C¼g¤J¸Ó ®Æ¥ó¥N¸¹
 Crr(Y(T1), 2) = Crr(Y(T1), 2) + Val(T2)
 '¡ô¥OCrr°}¦C²Ä2Äæ²Ö¥[ À³µo¼Æ¶q
 i01: Next
 Sha.[A:A].NumberFormatLocal = "@"
 '¡ô¥Oµ²ªGªíAÄæÀx¦s®æ®æ¦¡¬O¤å¦r
 Sha.[A1].Resize(R, 2) = Crr
 '¡ô¥Oµ²ªGªí[A1]ÂX®i½d³ò±a¤JCrr°}¦CÈ,¶W¹L¦¹½d³òªºCrr°}¦CÈ©¿²¤
 Set Y = Nothing: Set xRd = Nothing: Set Shd = Nothing
 Set Sha = Nothing: Erase Brr, Crr
 '¡ô¥OÄÀ©ñÅܼÆ
 End Sub
 | 
 | 
| ¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
 | 
|  |  | 
|  |  |