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

½Ð±Ð¦p¦ó¿z¿ï¦C¥X¤£­«Âиê®Æ¨Ã¥[Á`¼Æ¶q

½Ð±Ð¦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)

¤£¦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)

TOP

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

================================

TOP

¥»©«³Ì«á¥Ñ 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

TOP

¥»©«³Ì«á¥Ñ 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

TOP

        ÀR«ä¦Û¦b : ¦³´¼¼z¤~¯à¤À¿ëµ½´c¨¸¥¿¡F¦³Á¾µê¤~¯à«Ø¥ß¬üº¡¤H¥Í¡C
ªð¦^¦Cªí ¤W¤@¥DÃD