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

[µo°Ý] VBA­pºâ½c¤l¸¹½X

¦^´_ 1# john2006168


¤£¦n·N«ä¡A¬Ý¤£¤ÓÀ´¸Ñ³W«h¬O¤°»ò¡A¥i§_½Ð¦A²Ó»¡©ú¤@¤U¡AÁÂÁÂ

TOP

¦^´_ 3# john2006168

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁ¡C

Sub test()
Dim Arr, xD, TT, T, T1, T2, T3, N%, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = [A1].CurrentRegion
For i = 2 To UBound(Arr)
    T = Arr(i, 5): T2 = Arr(i, 2): T3 = Arr(i, 3)
    If xD.Exists(T & "") Then
        If N = 0 Then
            N = 1: TT = xD(T & "")(0)
        Else
            TT = xD(T & "")(0) + T1
        End If
        Arr(i, 1) = Arr(i, 5) & TT & "1" & "-" & T & T3 + xD(T & "")(1)
        xD(T & "") = Array(T2, T3 + xD(T & "")(1))
    Else
        Arr(i, 1) = Arr(i, 5) & "1" & "-" & T & T3
        xD(T & "") = Array(T2, T3): N = 0: T1 = xD(T & "")(0)
    End If
Next
Arr(1, 1) = "Carton"
Range("D1").Resize(UBound(Arr), 1) = Arr
End Sub

TOP

¦^´_ 5# john2006168

§ÚºÉ¤O¥[¤Jµù¸Ñ¡A¥i¯à¦³¨Ç¼g±o¤£¦n¤£¸Ô²Ó¡A½Ð±z¦Û¦æ¬ã¨s¤F¡AÁÂÁ¡C

Sub test1()
Dim Arr, xD, TT, T, T1, 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 = xD(T & "")(0) '­«½Æ¥X²{ªº²Ä1¦¸¨Ì³W«h½s¸¹(²Ä2½X)
        Else
            TT = xD(T & "")(0) + T1 '­«½Æ¥X²{ªº²Ä2¦¸¥H¤W¨Ì³W«h½s¸¹(²Ä2½X)
        End If
        Arr(i, 1) = Arr(i, 5) & TT & "1" & "-" & 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: T1 = xD(T & "")(0) 'B,CÄæ¸ê®Æ©ñ¤J¦r¨å¡AT1³]¬°BÄæ²Ä¤@¦¸¥X²{¼Æ­È¡AN=0Âk¹s(P-C)
    End If
Next
Arr(1, 1) = "Carton"
Range("d1").Resize(UBound(Arr), 1) = Arr
End Sub

TOP

¦^´_ 7# john2006168


½Ð°ÝPXX - ªº³W«h¦p¦ó??

TOP

¦^´_ 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

TOP

¤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

TOP

        ÀR«ä¦Û¦b : §g¤l¥ß«í§Ó¡A¤p¤H«í¥ß§Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD