½Ð±Ð¦p¦ó¿z¿ï¦C¥X¤£«ÂÐ¸ê®Æ¨Ã¥[Á`¼Æ¶q
 
- ©«¤l
 - 129 
 - ¥DÃD
 - 47 
 - ºëµØ
 - 0 
 - ¿n¤À
 - 206 
 - ÂI¦W
 - 0  
 - §@·~¨t²Î
 - 7 
 - ³nÅ骩¥»
 - 2007 
 - ¾\ŪÅv
 - 20 
 - ©Ê§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)
 
 
 
 
 |   
 
 
 
 | 
| 
 | 
 | 
 | 
 | 
 | 
 
- ©«¤l
 - 129 
 - ¥DÃD
 - 47 
 - ºëµØ
 - 0 
 - ¿n¤À
 - 206 
 - ÂI¦W
 - 0  
 - §@·~¨t²Î
 - 7 
 - ³nÅ骩¥»
 - 2007 
 - ¾\ŪÅv
 - 20 
 - ©Ê§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)
 |   
 
 
 
 | 
| 
 | 
 | 
 | 
 | 
 | 
 
- ©«¤l
 - 2843 
 - ¥DÃD
 - 10 
 - ºëµØ
 - 0 
 - ¿n¤À
 - 2899 
 - ÂI¦W
 - 0  
 - §@·~¨t²Î
 - ¡e²¤¡f 
 - ³nÅ骩¥»
 - ¡e²¤¡f 
 - ¾\ŪÅv
 - 100 
 - ©Ê§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 
  
================================ |   
 
 
 
 | 
| 
 | 
 | 
 | 
 | 
 | 
 
- ©«¤l
 - 1527 
 - ¥DÃD
 - 40 
 - ºëµØ
 - 0 
 - ¿n¤À
 - 1551 
 - ÂI¦W
 - 0  
 - §@·~¨t²Î
 - Windows  7 
 - ³nÅ骩¥»
 - Excel 2010 & 2016 
 - ¾\ŪÅv
 - 100 
 - ©Ê§O
 - ¨k 
 - ¨Ó¦Û
 - ¥xÆW 
 - µù¥U®É¶¡
 - 2020-7-15 
 - ³Ì«áµn¿ý
 - 2025-11-4 
 
  | 
                
 ¥»©«³Ì«á¥Ñ 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 
 | 
 | 
 | 
 | 
 | 
 
- ©«¤l
 - 1527 
 - ¥DÃD
 - 40 
 - ºëµØ
 - 0 
 - ¿n¤À
 - 1551 
 - ÂI¦W
 - 0  
 - §@·~¨t²Î
 - Windows  7 
 - ³nÅ骩¥»
 - Excel 2010 & 2016 
 - ¾\ŪÅv
 - 100 
 - ©Ê§O
 - ¨k 
 - ¨Ó¦Û
 - ¥xÆW 
 - µù¥U®É¶¡
 - 2020-7-15 
 - ³Ì«áµn¿ý
 - 2025-11-4 
 
  | 
                
 ¥»©«³Ì«á¥Ñ 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 
 | 
 | 
 | 
 | 
 |