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

[µo°Ý] ¦C¥X¤£¦PñÃÒ¸¹¤§²Ä¤@µ§¸¹½X¡A¨Ã±N¬Û¦PñÃÒ¸¹¤§¬y¤ô¸¹ª÷ÃB¥[Á`

[µo°Ý] ¦C¥X¤£¦PñÃÒ¸¹¤§²Ä¤@µ§¸¹½X¡A¨Ã±N¬Û¦PñÃÒ¸¹¤§¬y¤ô¸¹ª÷ÃB¥[Á`

½Ð°Ý¦p¦ó¦C¥X¤£¦PñÃÒ¸¹¤§²Ä¤@µ§¸¹½X¡A¨Ã±N¬Û¦PñÃÒ¸¹¤§¬y¤ô¸¹ª÷ÃB¥[Á`ªº¤½¦¡¡H
¨Ò¦p¡G106-111-0000065ñÃÒ¸¹¤§¬y¤ô¸¹¦³106-111-0000065001~009¡A¨ä¥[Á`ª÷ÃB¬°273,031



1120106-¬Û¦PñÃÒ¸¹ª÷ÃB¬Û¥[.rar (11.78 KB)

google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

¦^´_ 2# hcm19522

¤½¦¡´ú¸Õ¥¿±`¡A·PÁ±z¡I

TOP

¦^´_ 1# aer


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,½Ð«e½ú°Ñ¦Ò

°õ¦æµ²ªG:


Option Explicit
Sub TEST_20230106_1()
Dim Brr, i&, T1$, T2&, TT$, Y, M$, N&, P&
Set Y = CreateObject("Scripting.Dictionary")
Brr = [A1].CurrentRegion: N = 1
For i = 2 To UBound(Brr)
   T1 = Brr(i, 1): Brr(i, 1) = 0
   T2 = Brr(i, 2): Brr(i, 2) = 0
   TT = T1 & "|" & T2
   If Len(T1) = 15 And Not Y.Exists(T1) Then
      N = N + 1
      Y(T1) = N
      Brr(N, 1) = T1
      ElseIf Y(TT) = "" Then
         M = Left(T1, 15)
         Brr(Y(M), 2) = Brr(Y(M), 2) + T2
         P = P + T2
   End If
   Y(TT) = 1
Next
[E:F].ClearContents
With [E1].Resize(N, 2)
  .Value = Brr
  .Item(N + 1, 1) = "¦X­p": .Item(N + 1, 2) = P
End With
Set Y = Nothing
Set Brr = Nothing
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 4# Andy2483

´ú¸Õ¥¿±`¡A·PÁ«e½ú«ü¾É¡I

TOP

¦^´_ 1# aer

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, T$, T1, n&, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = [A1].CurrentRegion
For i = 2 To UBound(Arr)
    If Arr(i, 2) = "" Then GoTo 99
    T = Left(Arr(i, 1), 15)
    If xD.Exists(T) Then
        Arr(xD(T), 2) = Arr(xD(T), 2) + Arr(i, 2)
    Else
        n = n + 1: xD(T) = n
        Arr(n, 1) = T: Arr(n, 2) = Arr(i, 2)
    End If
    T1 = T1 + Arr(i, 2)
99: Next
[e1].CurrentRegion.Offset(1) = ""
[e2].Resize(n, 2) = Arr
Range("e" & n + 2) = "¦X­p"
Range("f" & n + 2) = T1
End Sub

TOP

¦^´_ 6# samwang

·PÁ«e½ú´£¨Ñ¥t¤@ºØ¤èªk¡A´ú¸Õ¥i¥Î¡AÁÂÁ±z¡I

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-1-17 08:11 ½s¿è

¦^´_ 7# aer


    ÁÂÁÂ samwang«e½ú
¤µ¤Ñ¾Ç²ß samwang«e½úªº¤è®×°µ¤ß±oµù¸Ñ,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub test()
Dim Arr, xD, T1, n&, i&, T$
'¡ô«Å§iÅܼÆ:(n,i)¬Oªø¾ã¼ÆÅܼÆ,T¬O¦r¦êÅܼÆ,¨ä¥¦¬O³q¥Î«¬ÅܼÆ
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD¬O ¦r¨å
Arr = [A1].CurrentRegion
'¡ô¥OArr¬O¤Gºû°}¦C!¥H ±q[A1]Àx¦s®æ¦ê±µ¤K¤è¬Û¾FÀx¦s®æÂX®i³Ì¤p¤è¥¿°Ï°ìÀx¦s®æ­È­Ë¤J
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q2¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹¼Æ
    If Arr(i, 2) = "" Then GoTo 99
    '¡ô¦pªGi°j°é¦C2ÄæArr°}¦C­È¬O ªÅ¦r¤¸!´N¸õ¨ì99¦ì¸mÄ~Äò°õ¦æ
    T = Left(Arr(i, 1), 15)
    '¡ô¥OT³o¦r¦êÅܼƬO i°j°é¦C1ÄæArr°}¦C­È¨ú¥ª°¼15­Ó¦rªº·sÅܼÆ
    If xD.Exists(T) Then
    '¡ô¦pªGTÅܼƬ°key¬dxD¦r¨å¬O¤w¸g¦s¦b¦r¨å¸Ì?
        Arr(xD(T), 2) = Arr(xD(T), 2) + Arr(i, 2)
        '¡ô¥O(TÅܼƦbxD¦r¨åªºitem­È¦C2Äæ)Arr°}¦C­È¬O ¦Û¨­­È+i°j°é¦C2ÄæArr°}¦C­È
    Else
    '¡ô¥H¤U¬OÃö©ó±ø¥ó¬°§_«hªºµ{§Ç
        n = n + 1
        '¡ô¥On³oªø¾ã¼ÆÅܼƬO ¦Û¨­²Ö¥[ 1ªº·s¾ã¼Æ  («ü©wµ²ªG¦C¸¹)
        xD(T) = n
        '¡ô¥OTÅܼƦbxD¦r¨åªºitem­È¬O nÅܼƠ (°O¾Ðµ²ªG¦C¸¹)
        Arr(n, 1) = T
        '¡ô¥O(nÅܼƦC1Äæ)Arr°}¦C­È¬O T¦r¦êÅܼƠ (µ²ªG¼g¤J°}¦C)
        Arr(n, 2) = Arr(i, 2)
        '¡ô¥O(nÅܼƦC2Äæ)Arr°}¦C­È¬O i°j°é¦C2ÄæArr°}¦C­È  (§âª÷ÃB­ÈÅܬ°µ²ªGªº·s­È)
    End If
    T1 = T1 + Arr(i, 2)
    '¡ô¥OT1³o³q¥Î«¬ÅܼƬO ¦Û¨­­È +  i°j°é¦C2ÄæArr°}¦C­È  (²Ö¥[¥þ³¡¦X­pª÷ÃB)
99: Next
[e1].CurrentRegion.Offset(1) = ""
'¡ô¥O[E1]Àx¦s®æ¦ê±µ¤K¤è¬Û¾FÀx¦s®æÂX®i³Ì¤p¤è¥¿°Ï°ì©¹¤U°¾²¾1¦CÀx¦s®æ­È¬OªÅ¦r¤¸
[e2].Resize(n, 2) = Arr
'¡ô¥O[E2]Àx¦s®æÂX®i¦V¤UnÅܼƦC ©¹¥kÂX®i2Ä檺½d³òÀx¦s®æ¥HArr°}¦C­È­Ë¤J
'¶W¹L³o½d³òªºArr°}¦C­È·|³Q©¿²¤
Range("e" & n + 2) = "¦X­p"
'¡ôEÄæn+2¦CÀx¦s®æ­È¬O "¦X­p"¦r¦ê
Range("f" & n + 2) = T1
'¡ôFÄæn+2¦CÀx¦s®æ­È¬O T1ÅܼƠ (¥þ³¡¦X­p)
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : «Ý¤H°h¤@¨B¡A·R¤H¼e¤@¤o¡A´N·|¬¡±o«Ü§Ö¼Ö¡C
ªð¦^¦Cªí ¤W¤@¥DÃD