samwang

¦^´_ 10# john2006168

½Ð¦A´ú¸Õ¬Ý¬Ý¡A·PÁ¡C

Sub test2()
Dim Arr, xD, TT, T, T2, T3, N%, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = [A1].CurrentRegion   '¸ê®Æ©ñ¤J¼Æ²Õ
For i = 2 To UBound(Arr)
    'T:EÄæ¸ê®Æ¡BT2:BÄæ¡BT3:CÄæ
    T = Arr(i, 5): T2 = Arr(i, 2): T3 = Arr(i, 3)
    If xD.Exists(T & "") Then '¦r¨å¦³µLEÄæ¸ê®Æ
        If N = 0 Then
            N = 1: TT = Arr(i - 1, 3) + 1 '­«½Æ¥X²{ªº²Ä1¦¸¨Ì³W«h½s¸¹(²Ä2½X)
        Else
            TT = xD(T & "")(1) + 1  '­«½Æ¥X²{ªº²Ä2¦¸¥H¤W¨Ì³W«h½s¸¹(²Ä2½X)
        End If
        Arr(i, 1) = Arr(i, 5) & TT & "-" & T & T3 + xD(T & "")(1)  '¨Ì³W«h½s¸¹
        xD(T & "") = Array(T2, T3 + xD(T & "")(1)) 'CÄæ(kg)²Ö¥[¸Ë¤J¦r¨å
    Else
        Arr(i, 1) = Arr(i, 5) & "1" & "-" & T & T3  '²Ä1¦¸¥X²{¡A¨Ì³W«h½s¸¹©ñ¤JArr
        xD(T & "") = Array(T2, T3): N = 0  'B,CÄæ¸ê®Æ©ñ¤J¦r¨å¡AN=0Âk¹s(P-C)
    End If
Next
Arr(1, 1) = "Carton"
Range("D1").Resize(UBound(Arr), 1) = Arr
End Sub

jcchiang

¦^´_ 10# john2006168
¸Õ¸Õ¬Ý
Sub ex()
Dim d As Object, a As Variant
Set d = CreateObject("Scripting.dictionary")
For Each a In Range([E2], [E65535].End(3))   '¦bEÄæ¦ì¸m§ä´M¸ê®Æ
   If Not d.exists(a.Value) Then   '¦r¨å¤¤§ä¤£¨ì¸ê®Æ
      d(a.Value) = a.Offset(, -2)  '±N¸ê®Æ¦s¤J¦r¨å
      a.Offset(, -1) = a.Value & "1-" & a.Value & a.Offset(, -2) '±N½d³ò¸ê®Æ¶ñ¤JÀx¦s®æ
   Else   '¦r¨å¤¤§ä¨ì¸ê®Æ
      a.Offset(, -1) = a.Value & d(a.Value) + 1 & "-" & a.Value & a.Offset(, -2) + d(a.Value) '±N½d³ò¸ê®Æ¶ñ¤JÀx¦s®æ
      d(a.Value) = a.Offset(, -2) + d(a.Value)   '§ó·s¦r¨å¸ê®Æ
   End If
Next
Set d = Nothing
End Sub

john2006168

¦^´_ 11# samwang

ÁÂÁ±z¦A¤T¦^ÂÐ,µ{¦¡¥i¥H¾Þ§@.

john2006168

¦^´_ 12# jcchiang

ÁÂÁ¦^ÂÐ,¥i¥H¾Ç²ß¤£¦P¼gªk.

samwang

¤W¦¸¼g±o¤£¦n¡A²¤Æ¤@¤U¦p¤U¡AÁÂÁ¡C

Sub test3()
Dim Arr, xD, T, T2, T3, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([A1], [E65536].End(3))  '¸ê®Æ©ñ¤J¼Æ²Õ
For i = 2 To UBound(Arr)
    'T:EÄæ¸ê®Æ¡BT2:BÄæ¡BT3:CÄæ
    T = Arr(i, 5): T2 = Arr(i, 2): T3 = Arr(i, 3)
    If xD.exists(T & "") Then '¦r¨å¦³µLEÄæ¸ê®Æ
        Arr(i, 4) = T & xD(T & "") + 1 & "-" & T & xD(T & "") + T3 '²Ä2¦¸¥H¤W¡A¨Ì³W«h½s¸¹©ñ¤JArr
        xD(T & "") = xD(T & "") + T3 'CÄæ(kg)²Ö¥[¸Ë¤J¦r¨å
    Else
        Arr(i, 4) = T & "1-" & T & T3  '²Ä1¦¸¥X²{¡A¨Ì³W«h½s¸¹©ñ¤JArr
        xD(T & "") = T3 'CÄæ(kg)¸Ë¤J¦r¨å
    End If
Next
Range("A1").Resize(UBound(Arr), UBound(Arr, 2)) = Arr
End Sub

john2006168

¦^´_ 15# samwang

¬Ý¨ì.,¨¯­W¤F.

Andy2483

¦^´_ 10# john2006168


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

°õ¦æ«e:

¤U¸ü (54.71 KB)

2023-3-16 16:17

°õ¦æµ²ªG:

¤U¸ü (63.93 KB)

2023-3-16 16:17

Option Explicit
Sub Test4()
Dim Brr, Y, N&, i&, xR As Range, T$
'¡ô«Å§iÅܼÆ:(Brr,Y)¬O³q¥Î«¬ÅܼÆ,(N,i)¬Oªø¾ã¼ÆÅܼÆ,
'xR¬OÀx¦s®æÅܼÆ,T¬O¦r¦êÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY³o³q¥Î«¬ÅܼƬO ¦r¨å
Set xR = Range([E1], [A65536].End(3))
'¡ô¥OxR³oÀx¦s®æÅܼƬO [E1]¨ìAÄæ³Ì«á¦³¤º®eÀx¦s®æ
Brr = xR
'¡ô¥OBrr³o³q¥Î«¬ÅܼƬO¤Gºû°}¦C,¥HxRÅܼƭȱa¤J
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q2¨ì BrrÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   T = Brr(i, 5): N = Y(T) + 1
   '¡ô¥O³o¦r¦êÅܼƬO i°j°é¦C²Ä5ÄæBrr°}¦C­È,
   '¥ON³oªø¾ã¼ÆÅܼƬO TÅܼƬdY¦r¨å¦^¶Çªºitem­È+1
   Y(T) = Y(T) + Brr(i, 3)
   '¡ô¥OY¦r¨å¤¤¥HTÅܼƬ°keyªºitem­È,²Ö¥[i°j°é¦C²Ä3ÄæBrr°}¦C­È
   Brr(i, 4) = T & N & "-" & T & Y(T)
   '¡ô¥Oi°j°é¦C²Ä4ÄæBrr°}¦C­È¬O TÅܼƳs±µNÅܼÆ,
   '¦A³s±µ"-",Äò³s±µTÅܼÆ,³Ì«á³s±µ(TÅܼƦbY¦r¨åªºitem­È),
   '³o¬O¦r¦ê
Next
xR = Brr
'¡ô¥OxRÅܼÆ(­ìÀx¦s®æ)­È¬O Brr°}¦C­È
Set Y = Nothing: Erase Brr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub