[µo°Ý] MARCO¤½¦¡¦X¨ÖÀx¦s®æ.©M¥ÎÃC¦â:¶À¦â ¤À¶}¤£¬Û¦P

john2006168

·Q°Ý¤@¤U¤j¤j°ª¤â,¦³¨S¦³Â²³æªºMARCO©ÎªÌ¤½¦¡¥i¥H°µ¨ìFÄ檺®ÄªG¡X(­pºâ¨C­ÓBATCH ªºÁ`©M,),µM«á¦X¨ÖÀx¦s®æ.
¥t¥~,¬O§_¥i¥H¦³MARCO¥ÎÃC¦â:¶À¦â ¤À¶}¤£¬Û¦PªºBATCH NO,¤è«K¬d¬Ý?
¤p§Ì²{¦b¦b¾Ç²ß¶¥¬q,¥u¥i¥HºCºC§Û¾Ç¤¤,§Æ±æ¦³¤H¥i¥H¤À¨É

hcm19522

https://blog.xuite.net/hcm19522/twblog/586986334

john2006168

¦^´_ 2# hcm19522

test is ok,thanks for your help.

­ã´£³¡ªL

Sub TEST()
Dim xR As Range, CL, U%, xH As Range, SS
Call ­«¸m
CL = Array(35, 36)
For Each xR In Range([C2], Cells(Rows.Count, "c").End(xlUp))
    If xR <> xR(0) Then Set xH = xR: SS = 0
    SS = SS + Val(xR(1, 3))
    If xR <> xR(2) Then
       xH(1, 4) = SS: U = 1 - U
       Range(xR, xH(1, 8)).Interior.ColorIndex = CL(U)
       Range(xH(1, 4), xR(1, 4)).Merge
    End If
Next
End Sub
  
Sub ­«¸m()
With Range([J2], Cells(Rows.Count, "c").End(xlUp))
     .UnMerge
     .Interior.ColorIndex = 0
     .Columns(4).ClearContents
End With
End Sub

Xl0000239.rar (12.6 KB)

¤U¸ü¦¸¼Æ: 25

2019-3-6 19:32

john2006168

¦^´_ 4# ­ã´£³¡ªL

¦hÁ¤j¤jÀ°¦£,ºCºC¾Ç²ß¤¤

john2006168

¦^´_ 4# ­ã´£³¡ªL


    ¦Ñ®v·Q°Ý¤@¤U,¦pªG§Ú±Nbatch no©ñ¨ìÄæK ,¼gªk«ä¸ô¬O§_¤£¦P,À³¸Ó¦p¦ó¼g?

­ã´£³¡ªL

¦^´_ 6# john2006168

Sub TEST()
Dim xR As Range, CL, U%, xH As Range, SS
Call ­«¸m
CL = Array(35, 36)
For Each xR In Range("D2:D" & Cells(Rows.Count, "k").End(xlUp).Row)  '¥HkÄæ¨ú¸ê®Æ¦C¼Æ, xR«h±qD2©¹¤U°j°é
    If xR(1, 8) <> xR(0, 8) Then Set xH = xR: SS = 0    'xR(1,8) DÄ橹¥k8®æ, §Y¬OKÄæ; xR(1, 8) <> xR(0, 8) 1¬O¥»®æ,0¬O¤W¤@®æ,2¬O¤U¤@®æ ---¥H¤Uµ{¦¡½X¦P²z
    SS = SS + Val(xR(1, 2))
    If xR(1, 8) <> xR(2, 8) Then
       xH(1, 3) = SS: U = 1 - U
       Range(xR(1, 8), xH).Interior.ColorIndex = CL(U)
       Range(xH(1, 3), xR(1, 3)).Merge
    End If
Next
End Sub
  
Sub ­«¸m()
With Range([D2], Cells(Rows.Count, "k").End(xlUp))
     .UnMerge
     .Interior.ColorIndex = 0
     .Columns(3).ClearContents
End With
End Sub