½Ð°Ýsumif §ï¼g¦¨¦r¨å©Î¬OarrayÅý°õ¦æ³t«×ÅܧÖ

s3526369

¥H¤U¬O§Ú¥Ø«e¥i¥H°õ¦æ ¦ý¬O¹Bºâ®É¶¡¦³ÂI¤[
½Ð°Ý¦³§ó¦nªº¤èªk¥i¥H¥h¨ú¥N¶Ü

1. Sub ­Ü®w®w¦s¦X­p()
   
2. Dim X, i As Long
   
3. For i = 4 To Sheets("­Ü®w®w¦s").[A1000].End(3).Row
   
4. 
   
5.     X = WorksheetFunction.SumIf(Sheets("¤J®w©ú²Ó").Range("O2:O600"), Sheets("­Ü®w®w¦s").Cells(i, 1), Sheets("¤J®w©ú²Ó").Range("R2:R600")) '¤J®w¦X­p
   
6.     DA = WorksheetFunction.SumIf(Sheets("¥þ¾÷ºØBOM").Range("P:P"), Sheets("­Ü®w®w¦s").Cells(i, 1), Sheets("¥þ¾÷ºØBOM").Range("Z:Z")) '¤½¥qÁ`»Ý¨D
   
7.     BA = WorksheetFunction.SumIf(Sheets("A»Ý¨D").Range("A:A"), Sheets("­Ü®w®w¦s").Cells(i, 1), Sheets("A»Ý¨D").Range("H:H")) 'A­Ü
   
8.     bb = WorksheetFunction.SumIf(Sheets("b»Ý¨D").Range("A:A"), Sheets("­Ü®w®w¦s").Cells(i, 1), Sheets("B»Ý¨D").Range("H:H")) 'B­Ü
   
9.     BC = WorksheetFunction.SumIf(Sheets("«ü¹Ï©ú²Ó").Range("F:F"), Sheets("­Ü®w®w¦s").Cells(i, 1), Sheets("«ü¹Ï©ú²Ó").Range("L:L")) 'Á`¥X³f
   
10.     FY = WorksheetFunction.SumIf(Sheets("¥X®w©ú²Ó").Range("H2:H600"), Sheets("¼o®Æ­Ü").Cells(i, 1) & Sheets("¼o®Æ­Ü").Cells(1, 1), Sheets("¥X®w©ú²Ó").Range("I2:I600"))  '¼o®Æ
    
11.     FX = WorksheetFunction.SumIf(Sheets("«ü¹Ï©ú²Ó").Range("F2:F2000"), Sheets("¼o®Æ­Ü").Cells(i, 1), Sheets("«ü¹Ï©ú²Ó").Range("K2:K2000")) '¼o®Æ
    
12.     EY = WorksheetFunction.SumIf(Sheets("¥X®w©ú²Ó").Range("H2:H600"), Sheets("°h®w").Cells(i, 1) & Sheets("°h®w").Cells(1, 1), Sheets("¥X®w©ú²Ó").Range("I2:I600"))   '°h®w
    
13. 
    
14.    
    
15.     QA = Sheets("­Ü®w®w¦s").Cells(i, 4) + Sheets("­Ü®w®w¦s").Cells(i, 5) ' ''­Ü®w®w¦s
    
16.     QB = Sheets("­Ü®w®w¦s").Cells(i, "K") + Sheets("­Ü®w®w¦s").Cells(i, "L")
    
17.    
    
18.     Sheets("­Ü®w®w¦s").Cells(i, 5) = X '¤J®w¦X­p
    
19.     Sheets("­Ü®w®w¦s").Cells(i, "M") = BC ''Á`¥X³f
    
20.     Sheets("­Ü®w®w¦s").Cells(i, "C") = DA ' Á`»Ý¨D
    
21.     Sheets("­Ü®w®w¦s").Cells(i, "H") = QA - QB - BA - bb - BC ''¤½¥q­Ü
    
22.     Sheets("­Ü®w®w¦s").Cells(i, "I") = bb ''B­Ü
    
23.     Sheets("­Ü®w®w¦s").Cells(i, "J") = BA ''A­Ü
    
24.     Sheets("­Ü®w®w¦s").Cells(i, "G") = QA - QB - BC ''Á`¼Æ
    
25.     Sheets("¼o®Æ­Ü").Cells(i, 3) = FY + FX
    
26.     Sheets("°h®w").Cells(i, 3) = EY
    
27. 
    
28. Next i
    
29. 
    
30. End Sub

½Æ»s¥N½X

Andy2483

¦^´_ 45# singo1232001


    ÁÂÁ«e½ú«ü¾É
¥H¤U¬O¤µ¤Ñ¾Ç²ß¤ß±oµù¸Ñ!¦p¦³«_¥Ç½Ð¨£½Ì!
½Ð«e½ú«ü¥¿¨Ã«ü¾É!ÁÂÁÂ!
Option Explicit
Sub ­Ü®w®w¦s2()
Dim d, S, sA, sB, Ar, Z, sC, Lr, j, i, C, r, a23910
Set d = CreateObject("Scripting.Dictionary")
'¡ô¥Od¬O¦r¨å
Set S = Sheets("§÷®Æªí")
'¡ô¥Od¬Oª«¥ó "§÷®Æªí" ¤u§@ªí!¥H¤UºÙ §÷®Æªí
For Each Z In S.Range("a2:a" & S.Cells(Rows.Count, 1).End(3).Row)
'¡ô#³]¶¶°j°é¥OZ¬O §÷®Æªí [A2]¨ìAÄ檺³Ì«á¤@®æ¤¤ªº¤@®æ,©Ò¥HZ¬Oª«¥óÀx¦s®æ
   d(Z.Value) = Z.Row - 1   '@
   '¡ô§â¤W­z#Àx¦s®æ­È·íkey­Ë¤Jd¦r¨å¸Ì,item¬OZ©Ò¦bªº¦C¦ì¼Æ-1
Next
sA = Split("¥þ¾÷ºØBOM,¤½¥q½LÂI,¤J®w©ú²Ó,A»Ý¨D,B»Ý¨D,°h®w,¼o®Æ­Ü,«ü¹Ï©ú²Ó", ",")
'¡ô¥O sA¬O¤@ºû°}¦C,­Ë¤J¥Î "," ¤À³Î¤u§@ªí¦r¦ê²Õ,¦¨¬°8­Ó¦r¦ê ±q0~7
sB = Split("p:z,a:g,o:r,a:h,a:h,a:c,a:c,f:l", ",")
'¡ô¥O sB¬O¤@ºû°}¦C,­Ë¤J¥Î "," ¤À³ÎÀx¦s®æÄæ¦ì ÃöÁä¦rÄæ:·j´Mµ²ªGÄæ
ReDim Ar(1 To d.Count, 1 To 11) As Double
'¡ô«Å§i Ar¬O¼Æ¦r°}¦C,Áa¦V±q1 ¨ìd¦r¨å¸Ì¤¸¯À¼Æ¦C,¾î¦V±q1 ¨ì11Äæ
For i = 0 To UBound(sA) '©ñ¸ê®Æ
'¡ô³]¥~¶¶°j°é,±q0¶}©l¨ì sA¤@ºû°}¦Cªº³Ì«á¤@­Ó¼Æ 7
   Set S = Sheets(sA(i))
   '¡ô¥OS¬O ª«¥ó °j°é¸Ìªº¤u§@ªí ¥H¤UºÙ(°j°éªí)
   sC = Split(sB(i), ":")
   '¡ô¥O sC¬O¤@ºû°}¦C ­Ë¤J¥Î ":" ¤À³ÎsB¤@ºû°}¦C¸Ìªº°j°é«ü©w¦r¦ê
   Lr = S.Cells(Rows.Count, sC(0)).End(3).Row
   '¡ô¥O Lr¬O°j°éªí¸Ì«ü©wªº §÷®Æ®Æ¸¹Äæ ¦³¤º®eªº³Ì«á¦C¼Æ
   C = Split("1,2,3,8,7,9,10,11", ",")(i)
   '¡ô¥O C¬O¤@ºû°}¦C ­Ë¤J¥Î "," ¤À³Îµ²ªGªíÄæ¦ì¦r¦ê
   For j = 1 To Lr
   '¡ô³]¤º¶¶°j°é ±q1 ¨ì °j°éªí¸Ì«ü©wªº §÷®Æ®Æ¸¹Äæ ¦³¤º®eªº³Ì«á¦C¼Æ
      r = S.Cells(j, sC(0)).Value
     '¡ô¥Or¬O °j°éªí¸Ì §÷®Æ®Æ¸¹Ä椺°j°éÀx¦s®æªº­È,¥H¤UºÙ(ÃöÁä¦r)
      If d.exists(r) Then
      '¡ô¦pªG ÃöÁä¦r¦b¦r¨å¸Ì¬d±o¨ì
         Ar(d(r), C) = Ar(d(r), C) + S.Cells(j, sC(1)).Value
         '¡ôAr°}¦C¦ì§}: @¼Ð¥Ü³B¦r¨åd,key¬°ÃöÁä¦r,ªºItem¦C¦ì,µ²ªGªíÄæ¦ì
         'Åý°}¦C¤¤ªºµ²ªG­È²Ö¥[·j´MÃöÁä¦r±o¨ìªºµ²ªGÄæ¼Æ¶q­È
      End If
   Next
Next
For i = 1 To UBound(Ar)  '­pºâ¤@¤U
    a23910 = Ar(i, 3) + Ar(i, 2) - Ar(i, 9) - Ar(i, 10)
    Ar(i, 4) = a23910 - Ar(i, 1): If Ar(i, 4) >= 0 Then Ar(i, 4) = 0
    Ar(i, 5) = a23910 - Ar(i, 11)
    Ar(i, 6) = Ar(i, 5) - Ar(i, 8) - Ar(i, 7)
Next
Sheets("­Ü®w®w¦s").Range("c4").Resize(UBound(Ar), 11) = Ar
'¡ô±Nµ²ªG°}¦C­È±q"­Ü®w®w¦s"ªí[C4]¶K¤J!
'¥Î§÷®ÆªíªºÃöÁä¦r§ä¸ê®Æ!¶K¨ì"­Ü®w®w¦s"ªí!­·ÀI­å¤j!
End Sub

singo1232001

¦^´_ 44# singo1232001

'¦³¿ù ­×¥¿¤@¤U

    Sub ­Ü®w®w¦s2()
Set d = CreateObject("Scripting.Dictionary")
Set s = Sheets("§÷®Æªí")
For Each Z In s.Range("a2:a" & s.Cells(Rows.Count, 1).End(3).Row)
d(Z.Value) = Z.Row - 1: Next
            '1            '2     '3      8      7    9     10     11
sA = Split("¥þ¾÷ºØBOM,¤½¥q½LÂI,¤J®w©ú²Ó,A»Ý¨D,B»Ý¨D,°h®w,¼o®Æ­Ü,«ü¹Ï©ú²Ó", ",")
sB = Split("p:z,a:g,o:r,a:h,a:h,a:c,a:c,f:l", ",")
ReDim Ar(1 To d.Count, 1 To 11) As Double

For i = 0 To UBound(sA) '©ñ¸ê®Æ
Set s = Sheets(sA(i))
sC = Split(sB(i), ":")
Lr = s.Cells(Rows.Count, sC(0)).End(3).Row
    c = Split("1,2,3,8,7,9,10,11", ",")(i)
    For j = 1 To Lr
     r = s.Cells(j, sC(0)).Value
      If d.exists(r) Then Ar(d(r), c) = Ar(d(r), c) + s.Cells(j, sC(1)).Value
    Next
Next

For i = 1 To UBound(Ar)  '­pºâ¤@¤U
    a23910 = Ar(i, 3) + Ar(i, 2) - Ar(i, 9) - Ar(i, 10)
    Ar(i, 4) = a23910 - Ar(i, 1): If Ar(i, 4) >= 0 Then Ar(i, 4) = 0
    Ar(i, 5) = a23910 - Ar(i, 11)
    Ar(i, 6) = Ar(i, 5) - Ar(i, 8) - Ar(i, 7)
Next
Sheets("­Ü®w®w¦s").Range("c4").Resize(UBound(Ar) - 1, 11) = Ar
End Sub

singo1232001

Sub ­Ü®w®w¦s()
Set d = CreateObject("Scripting.Dictionary")
r = Sheets("§÷®Æªí").Cells(Rows.Count, 1).End(3).Row
For Each Z In Sheets("§÷®Æªí").Range("a2:a" & r)
d(Z.Value) = Z.Row - 1
Next
            '1            '2     '3      8      7    9     10     11
sA = Split("¥þ¾÷ºØBOM,¤½¥q½LÂI,¤J®w©ú²Ó,A»Ý¨D,B»Ý¨D,°h®w,¼o®Æ­Ü,«ü¹Ï©ú²Ó", ",")
sB = Split("p:z,a:g,o:r,a:h,a:h,a:c,a:c,f:l", ",")
ReDim Ar(1 To d.Count, 1 To 11) As Double

For i = 0 To UBound(sA) '©ñ¸ê®Æ
Set s = Sheets(sA(i))
sC = Split(sB(i), ":")
r = s.Cells(Rows.Count, sC(0)).End(3).Row
    c = Split("1,2,3,8,7,9,10,11", ",")(i)
    For j = 1 To r
     If d.exists(s.Cells(j, sC(0)).Value) Then
        Ar(d(s.Cells(j, sC(0)).Value), c) = Ar(d(s.Cells(j, sC(0)).Value), c) + s.Cells(j, sC(1)).Value
     End If
    Next
Next

For i = 1 To UBound(Ar)  '­pºâ¤@¤U
    a23910 = Ar(i, 3) + Ar(i, 2) - Ar(i, 9) - Ar(i, 10)
    Ar(i, 6) = a23910 - Ar(i, 11) - Ar(i, 8) - Ar(i, 7)
    Ar(i, 5) = a23910 - Ar(i, 11)
    Ar(i, 4) = a23910 - Ar(i, 1)
    If Ar(i, 4) >= 0 Then Ar(i, 4) = 0
Next
Sheets("­Ü®w®w¦s").Range("c4").Resize(UBound(Ar) - 1, 11) = Ar
End Sub

Andy2483

¦^´_ 40# Andy2483
¤µ¤Ñ¦^ÅU¦¹©«§â¦¹©«ªº¤ß±oµù¸Ñ¤@¤U
·íªì¬O¶Ã¸Õ¦¨¥\·|¶]ªº! ¯uªº¬Oé¤Wªº!
½Ð¦U¦ì«e½ú«ü¥¿¨Ã«ü¾É!

Option Explicit
Sub A»Ý¨D_20220919()
Application.ScreenUpdating = False
Dim x&, i&, QA, QB, T, S, Srr, Arr, Ac, xR, C
Dim Trr, Brr, Crr, Rs, Rq1s, Rq1n, Ras, Ran, B, ¯Srr, Drr
Dim Rq2s, Rq2n, XA
'¡ô«Å§iÅܼÆ
T = Timer
Set Srr = CreateObject("Scripting.Dictionary")
Set Trr = CreateObject("Scripting.Dictionary")
Set ¯Srr = CreateObject("Scripting.Dictionary")
'¡ô¥OSrr,Trr,¯Srr¬O¦r¨å
S = Split("A»Ý¨D,¤J®w©ú²Ó,¥X®w©ú²Ó,¥þ¾÷ºØBOM,«ü¹Ï©ú²Ó,¤½¥q½LÂI,¤½¥q½LÂI,¤½¥q½LÂI", ",")
'¡ô¥OS¬O¤@ºû°}¦C!¸Ë¤J ¤u§@ªí¦W¦r¦ê¥Î "," ²Å¸¹©î¸Ñ¦¨8­Ó¦r¦ê,±q0~7
For i = 1 To UBound(S)
'¡ô³]¶¶°j°é³]©w«á7­Ó¦r¦ê¬O¤À§O¬O¤T­Ó¦r¨åªºKEY
   Set Srr(i) = Sheets(S(i)).Cells
   '¡ôSrrªºItem¬O7­Ó¤u§@ªí
   Set Trr(i) = CreateObject("Scripting.Dictionary")
   '¡ôTrrªºItem¬O7­Ó·s¦r¨å
   Set ¯Srr(i) = CreateObject("Scripting.Dictionary")
   '¡ô¯SrrªºItem¬O7­Ó·s¦r¨å
Next
Rs = Rows.Count
'¡ô¥ORs¬O³oªíªº·¥­­¦C¼Æ 1048576
Ac = Sheets(S(0)).Cells(Rs, 1).End(3).Row
'¡ô¥OAc¬O "A»Ý¨D"ªíªºAÄæ³Ì«á¤@­Ó¦³¤º®e®æ
Arr = Range(Sheets(S(0)).[H4], Sheets(S(0)).Cells(Ac, 1))
'¡ô¥OArr¬O°}¦C¸Ë¤J Ac »P "A»Ý¨D"ªíªº[H4] ,
'³o¨â­Ó¹ï¨¤®æ²[»\ªº¤è¥¿³Ì¤p°Ï°ìÀx¦s®æ­È
¯Srr(1) = Array("", 1, 18, 1, 15, 0, 1, 1, 19, "A­Ü") '¤J®w¦X­p
'¡ô±N°}¦C­È·íITEM,KEY¬O0~9 ­Ë¤J ¯Srr(1)³o¦r¨å¤¤ªº¦r¨å
'¡ô¦r¨å¤¤ªº¦r¨åKEY 0 ªºITEM ¬O"" ªÅ¦r¤¸,¬O«á­±µ{§Ç¨S¦³¥Î¨ìªº
'¯Âºé¬O­nÅý«á­±µ{§Ç±qkey 1 ¶}©l¤Þ¥Î
'¡ô¦r¨å¤¤ªº¦r¨åKEY 1 ,KEY 2 ITEM(1, 18)
',¬O¥Î¨Ó«ü¤Þ²Ä1­Óªí "¤J®w©ú²Ó" ªí­n¨úRÄæ¸ê®Æ
'¡ô¦r¨å¤¤ªº¦r¨åKEY 3 ,KEY 4 ITEM(1, 15)
',¬O¥Î¨Ó«ü¤Þ²Ä1­Óªí "¤J®w©ú²Ó" ªí­n¨úOÄæ¸ê®Æ
'¡ô¦r¨å¤¤ªº¦r¨åKEY 5 ,KEY 6 ITEM(0, 1)
',¬O³Æ¥Îªº!¦pªG¼Ó¥Dªº»Ý¨D¦bµ²ªGªíÁÙ­n¼W¥[±ø¥ó¥Îªº
'¡ô¦r¨å¤¤ªº¦r¨åKEY 7 ,KEY 8 ITEM(1, 19)
',¬O¥Î¨Ó«ü¤Þ²Ä1­Óªí "¤J®w©ú²Ó" ªí­n¨úSÄæ¸ê®Æ
'¡ô¦r¨å¤¤ªº¦r¨åKEY 9 ITEM¬O "A­Ü" (²Ä¤G­Ó§PÂ_±ø¥óÃöÁä¦r)

'¡õ«áÄò¨Ì¤W­zÃþ±À, ¸Ì­±ªº 99 ¬OCUÄ檺·N«ä
¯Srr(2) = Array("", 2, 18, 2, 15, 0, 1, 2, 19, "A­Ü") '¥X®w¦X­p
¯Srr(3) = Array("", 3, 26, 3, 16, 0, 1, 3, 20, "A­Ü") '¥þ¾÷ºØBOM-Á`»Ý¨D
¯Srr(4) = Array("", 4, 12, 4, 6, 0, 1, 4, 10, "A­Ü")  '«ü¹Ï©ú²Ó-Á`¥X³f
¯Srr(5) = Array("", 5, 6, 5, 1, 0, 1, 5, 99, "") '¤½¥q½LÂI-A­Ü
¯Srr(6) = Array("", 6, 11, 6, 1, 0, 1, 6, 99, "")  '¤½¥q½LÂI-A­Ü½Õ¾ã
¯Srr(7) = Array("", 7, 7, 7, 1, 0, 1, 7, 99, "")  '½LÂIªí

For i = 1 To UBound(S)
'¡ô³]¥~¶¶°j°é±q 1 ¨ì S°}¦Cªº³Ì«á¤@­Ó 7
   Set Rq1s = Srr(¯Srr(i)(3))(1, ¯Srr(i)(4))
   Set Rq1n = Srr(¯Srr(i)(3))(Rs, ¯Srr(i)(4)).End(3)
   Brr = Srr(¯Srr(i)(3)).Range(Rq1s, Rq1n)
   '¡ô¥OBrr¬O°}¦C ±N±ø¥ó1ªºÀx¦s®æ­È¸ê®Æ­Ë¤J,·í³Q·j´MªºÃöÁä¦r
   
   Set Rq2s = Srr(¯Srr(i)(7))(1, ¯Srr(i)(8))
   Set Rq2n = Srr(¯Srr(i)(7))(Rq1n.Row, ¯Srr(i)(8))
   Drr = Srr(¯Srr(i)(7)).Range(Rq2s, Rq2n)
   '¡ô¥ODrr¬O°}¦C ±N±ø¥ó2ªºÀx¦s®æ­È¸ê®Æ­Ë¤J,·í³Q·j´MªºÃöÁä¦r

   Set Ras = Srr(¯Srr(i)(1))(1, ¯Srr(i)(2))
   Set Ran = Srr(¯Srr(i)(1))(Rq1n.Row, ¯Srr(i)(2))
   Crr = Srr(¯Srr(i)(1)).Range(Ras, Ran)
   '¡ô¥OCrr¬O°}¦C µ²ªGÀx¦s®æ­È¸ê®Æ­Ë¤J
   For x = 1 To UBound(Brr)
   '¡ô³]¤º¶¶°j°é±q 1 ¨ì ²Ä1±ø¥óªº³Ì«á­Ó
      B = Brr(x, 1)
      '¡ô³f«~½s¸¹
      If InStr(Drr(x, 1), ¯Srr(i)(9)) Or Drr(x, 1) & ¯Srr(i)(9) = "" Then
      '¡ô¦pªG²Ä¤G±ø¥ó¦¨¥ß ©Î
      '²Ä¤G±ø¥óªºÃöÁä¦rÄæ®æ­È»P ¯Srr(i)²Ä9­ÓITEM ²Õ¦Xªº¦r¦ê¬OªÅ¦r¤¸
      
      '¦]¬° ¦pªG¨S¦³²Ä¤G±ø¥ó§PÂ_ªº¤u§@ªí¸ê®Æ!¤]­n³Ð¥ß¦r¨å¨Ñ«áÄò¤Þ¥Î
      ''¦¹½d¨ÒCUÄæ¤@©w¬OªÅ®æ,»P¯Srr(i)(9) = ""²Õ¦X¦r¦ê¤]¬OªÅ®æ!
      '©Ò¥H²Ä¤G±ø¥ó¤@©w·|¦¨¥ß!
      '¦]¬°²Ä¤@±ø¥ó´N¬O ³f«~½s¸¹ ¬O¦r¨å¤@©w·|¯Ç¤J
         Trr(i)(B) = Trr(i)(B) + Crr(x, 1)
         '¡ô±ø¥ó¦¨¥ß´N§â ³f«~½s¸¹·íkey¥h°£­«½Æ,µ²ªGÀx¦s®æ­È²Ö¥[·íitem
      End If
   Next
Next
For i = 1 To Ac - 3
'¡ô³]¶¶°j°é±N¸ê®Æ±a¤J©Î­pºâ«á¦A±a¤J!
   xR = Arr(i, 1)
   Arr(i, 4) = Trr(7)(xR)
   Arr(i, 5) = Trr(3)(xR)
   Arr(i, 6) = Trr(1)(xR) + Trr(2)(xR)
   Arr(i, 8) = Trr(5)(xR) + Trr(6)(xR)
   If Trr(3)(xR) = 0 Then Arr(i, 5) = 0
   If Trr(7)(xR) = 0 Then Arr(i, 4) = 0
   If Trr(1)(xR) + Trr(2)(xR) = 0 Then Arr(i, 6) = 0
   If Trr(5)(xR) + Trr(6)(xR) = 0 Then Arr(i, 8) = 0
   Arr(i, 7) = Trr(5)(xR) + Trr(6)(xR) + Trr(1)(xR) + Trr(2)(xR) - Trr(3)(xR)
   If Arr(i, 7) >= 0 Then Arr(i, 7) = 0
Next i
Sheets(S(0)).[A4].Resize(UBound(Arr), 8) = Arr
MsgBox "¦@¯Ó®É¡G" & Timer - T & " ¬í"
End Sub

s3526369

¦^´_ 36# Andy2483
ÁÂÁ§A ¦³­×§ï¤F
¦^´_ 40# Andy2483
«e½ú~¤]¤Ó¼F®`¤F!«Ü¦hºØ¤èªk,¦³ÂI¬Ý¤£¤ÓÀ´,¦ýºCºC¬ã¨sÀ³¸Ó¥i¥H²z¸Ñ!

s3526369

¦^´_ 34# samwang


    ·PÁ«e½ú ~´ú¸Õ¥i¥H!

Andy2483

ÁÂÁ ¨â¦ì«e½ú
¤µ¤Ñ²ß±o
1.­Ë¤J¦r¨å°j°é¤Æ
2.¹w³]2±ø¥ó§k¦X¤~¥[Á`
Andy2483 µoªí©ó 2022-9-17 16:58

2.¹w³]2±ø¥ó§k¦X¤~¥[Á`®M¤J A»Ý¨D ¥i¥H¥Î

1. Option Explicit
   
2. Sub A»Ý¨D_20220919()
   
3. Application.ScreenUpdating = False
   
4. Dim x&, i&, QA, QB, T, S, Srr, Arr, Ac, xR, C
   
5. Dim Trr, Brr, Crr, Rs, Rq1s, Rq1n, Ras, Ran, B, ¯Srr, Drr
   
6. Dim Rq2s, Rq2n, XA
   
7. T = Timer
   
8. Set Srr = CreateObject("Scripting.Dictionary")
   
9. Set Trr = CreateObject("Scripting.Dictionary")
   
10. Set ¯Srr = CreateObject("Scripting.Dictionary")
    
11.       '        0     1       2        3        4         5        6        7
    
12. S = Split("A»Ý¨D,¤J®w©ú²Ó,¥X®w©ú²Ó,¥þ¾÷ºØBOM,«ü¹Ï©ú²Ó,¤½¥q½LÂI,¤½¥q½LÂI,¤½¥q½LÂI", ",")
    
13. For i = 1 To UBound(S)
    
14.    Set Srr(i) = Sheets(S(i)).Cells
    
15.    Set Trr(i) = CreateObject("Scripting.Dictionary")
    
16.    Set ¯Srr(i) = CreateObject("Scripting.Dictionary")
    
17. Next
    
18. Rs = Rows.Count
    
19. Ac = Sheets(S(0)).Cells(Rs, 1).End(3).Row
    
20. Arr = Range(Sheets(S(0)).[H4], Sheets(S(0)).Cells(Ac, 1))
    
21.                   'vS, vC,zS, zC,xS,xC,zS, zC,zV
    
22. ¯Srr(1) = Array("", 1, 18, 1, 15, 0, 1, 1, 19, "A­Ü") '¤J®w¦X­p
    
23. ¯Srr(2) = Array("", 2, 18, 2, 15, 0, 1, 2, 19, "A­Ü") '¥X®w¦X­p
    
24. ¯Srr(3) = Array("", 3, 26, 3, 16, 0, 1, 3, 20, "A­Ü") '¥þ¾÷ºØBOM-Á`»Ý¨D
    
25. ¯Srr(4) = Array("", 4, 12, 4, 6, 0, 1, 4, 10, "A­Ü")  '«ü¹Ï©ú²Ó-Á`¥X³f
    
26. ¯Srr(5) = Array("", 5, 6, 5, 1, 0, 1, 5, 99, "") '¤½¥q½LÂI-A­Ü
    
27. ¯Srr(6) = Array("", 6, 11, 6, 1, 0, 1, 6, 99, "")  '¤½¥q½LÂI-A­Ü½Õ¾ã
    
28. ¯Srr(7) = Array("", 7, 7, 7, 1, 0, 1, 7, 99, "")  '½LÂIªí
    
29. For i = 1 To UBound(S)
    
30.    Set Rq1s = Srr(¯Srr(i)(3))(1, ¯Srr(i)(4))
    
31.    Set Rq1n = Srr(¯Srr(i)(3))(Rs, ¯Srr(i)(4)).End(3)
    
32.    Brr = Srr(¯Srr(i)(3)).Range(Rq1s, Rq1n)
    
33.    
    
34.    Set Rq2s = Srr(¯Srr(i)(7))(1, ¯Srr(i)(8))
    
35.    Set Rq2n = Srr(¯Srr(i)(7))(Rq1n.Row, ¯Srr(i)(8))
    
36.    Drr = Srr(¯Srr(i)(7)).Range(Rq2s, Rq2n)
    
37. 
    
38.    Set Ras = Srr(¯Srr(i)(1))(1, ¯Srr(i)(2))
    
39.    Set Ran = Srr(¯Srr(i)(1))(Rq1n.Row, ¯Srr(i)(2))
    
40.    Crr = Srr(¯Srr(i)(1)).Range(Ras, Ran)
    
41.    For x = 1 To UBound(Brr)
    
42.       B = Brr(x, 1)
    
43.       If InStr(Drr(x, 1), ¯Srr(i)(9)) Or Drr(x, 1) & ¯Srr(i)(9) = "" Then
    
44.          Trr(i)(B) = Trr(i)(B) + Crr(x, 1)
    
45.       End If
    
46.    Next
    
47. Next
    
48. For i = 1 To Ac - 3
    
49.    xR = Arr(i, 1)
    
50.    Arr(i, 4) = Trr(7)(xR)
    
51.    Arr(i, 5) = Trr(3)(xR)
    
52.    Arr(i, 6) = Trr(1)(xR) + Trr(2)(xR)
    
53.    Arr(i, 8) = Trr(5)(xR) + Trr(6)(xR)
    
54.    If Trr(3)(xR) = 0 Then Arr(i, 5) = 0
    
55.    If Trr(7)(xR) = 0 Then Arr(i, 4) = 0
    
56.    If Trr(1)(xR) + Trr(2)(xR) = 0 Then Arr(i, 6) = 0
    
57.    If Trr(5)(xR) + Trr(6)(xR) = 0 Then Arr(i, 8) = 0
    
58.    Arr(i, 7) = Trr(5)(xR) + Trr(6)(xR) + Trr(1)(xR) + Trr(2)(xR) - Trr(3)(xR)
    
59.    If Arr(i, 7) >= 0 Then Arr(i, 7) = 0
    
60. Next i
    
61. Sheets(S(0)).[A4].Resize(UBound(Arr), 8) = Arr
    
62. MsgBox "¦@¯Ó®É¡G" & Timer - T & " ¬í"
    
63. End Sub

½Æ»s¥N½X

Andy2483

¦^´_ 33# s3526369


    ´£¿ô«e½úÃö©ó Sub A»Ý¨D()
1.Arr(i, 3) ¨S¦³¶ñ¤J­È
2.xD3¦r¨å³Ð«Ø«á¨S¦³³Q¨Ï¥Î
3.¨D¥Xªº­È»P ªì©lªº½d¨Ò  ­Ü®w¦X­p.rar  ¦³®t²§

Andy2483

¦^´_ 37# Andy2483


        ÁÂÁ½׾Â
        ÁÂÁ¦U¦ì«e½ú
²§·Q¤Ñ¶}!´ú¸ÕOK
Set Srr(i) = Sheets(S(i))
§ï¬°
Set Srr(i) = Sheets(S(i)).Cells
«á¤èªºCells³£¥i¥H¬Ù²¤

1. Option Explicit
   
2. Sub ­Ü®w®w¦s_20220919()
   
3. Application.ScreenUpdating = False
   
4. Dim x&, i&, QA, QB, T, S, Srr, Arr, Ac, xR, C
   
5. Dim Trr, Brr, Crr, Rs, Rq1s, Rq1n, Ras, Ran, B, ¯Srr, Drr
   
6. Dim Rq2s, Rq2n, XA
   
7. T = Timer
   
8. Set Srr = CreateObject("Scripting.Dictionary")
   
9. Set Trr = CreateObject("Scripting.Dictionary")
   
10. Set ¯Srr = CreateObject("Scripting.Dictionary")
    
11.       '        0        1       2        3     4       5       6      7     8
    
12. S = Split("­Ü®w®w¦s,¤J®w©ú²Ó,¥þ¾÷ºØBOM,A»Ý¨D,B»Ý¨D,«ü¹Ï©ú²Ó,¤½¥q½LÂI,°h®w,¼o®Æ­Ü", ",")
    
13. For i = 1 To UBound(S)
    
14.    Set Srr(i) = Sheets(S(i)).Cells
    
15.    Set Trr(i) = CreateObject("Scripting.Dictionary")
    
16.    Set ¯Srr(i) = CreateObject("Scripting.Dictionary")
    
17. Next
    
18. Rs = Rows.Count
    
19. Ac = Sheets(S(0)).Cells(Rs, 1).End(3).Row
    
20. Arr = Range(Sheets(S(0)).[N4], Sheets(S(0)).Cells(Ac, 1))
    
21.                   'vS, vC,zS, zC,xS,xC,zS, zC,zV
    
22. ¯Srr(1) = Array("", 1, 18, 1, 15, 0, 1, 1, 99, "") '¤J®w¦X­p
    
23. ¯Srr(2) = Array("", 2, 26, 2, 16, 0, 1, 2, 99, "") '¤½¥qÁ`»Ý¨D
    
24. ¯Srr(3) = Array("", 3, 8, 3, 1, 0, 1, 3, 99, "") 'A­Ü
    
25. ¯Srr(4) = Array("", 4, 8, 4, 1, 0, 1, 4, 99, "")  'B­Ü
    
26. ¯Srr(5) = Array("", 5, 12, 5, 6, 0, 1, 5, 99, "") 'Á`¥X³f
    
27. ¯Srr(6) = Array("", 6, 7, 6, 1, 0, 1, 6, 99, "")  '¤½¥q½LÂI
    
28. ¯Srr(7) = Array("", 7, 3, 7, 1, 0, 1, 7, 99, "")  'B­Ü
    
29. ¯Srr(8) = Array("", 8, 3, 8, 1, 0, 1, 8, 99, "")  'B­Ü
    
30. For i = 1 To UBound(S)
    
31.    Set Rq1s = Srr(¯Srr(i)(3))(1, ¯Srr(i)(4))
    
32.    Set Rq1n = Srr(¯Srr(i)(3))(Rs, ¯Srr(i)(4)).End(3)
    
33.    Brr = Srr(¯Srr(i)(3)).Range(Rq1s, Rq1n)
    
34.   
    
35.    Set Rq2s = Srr(¯Srr(i)(7))(1, ¯Srr(i)(8))
    
36.    Set Rq2n = Srr(¯Srr(i)(7))(Rq1n.Row, ¯Srr(i)(8))
    
37.    Drr = Srr(¯Srr(i)(7)).Range(Rq2s, Rq2n)
    
38. 
    
39.    Set Ras = Srr(¯Srr(i)(1))(1, ¯Srr(i)(2))
    
40.    Set Ran = Srr(¯Srr(i)(1))(Rq1n.Row, ¯Srr(i)(2))
    
41.    Crr = Srr(¯Srr(i)(1)).Range(Ras, Ran)
    
42.    For x = 1 To UBound(Brr)
    
43.       B = Brr(x, 1)
    
44.       If InStr(Drr(x, 1), ¯Srr(i)(9)) Or Drr(x, 1) & ¯Srr(i)(9) = "" Then
    
45.          Trr(i)(B) = Trr(i)(B) + Crr(x, 1)
    
46.       End If
    
47.    Next
    
48. Next
    
49. For i = 1 To Ac - 3
    
50.    xR = Arr(i, 1)
    
51.    QA = Trr(1)(xR) + Trr(6)(xR) '­Ü®w®w¦s
    
52.    QB = Trr(7)(xR) + Trr(8)(xR)
    
53.    Arr(i, 5) = Trr(1)(xR)    '¤J®w¦X­p
    
54.    Arr(i, 13) = Trr(5)(xR)  'Á`¥X³f
    
55.    Arr(i, 3) = Trr(2)(xR)   'Á`»Ý¨D
    
56.    Arr(i, 8) = QA - QB - Trr(3)(xR) - Trr(4)(xR) - Trr(5)(xR) '¤½¥q­Ü
    
57.    Arr(i, 9) = Trr(4)(xR)   'B­Ü
    
58.    Arr(i, 10) = Trr(3)(xR)  'A­Ü
    
59.    Arr(i, 7) = QA - QB - Trr(5)(xR)  'Á`¼Æ
    
60.    Arr(i, 4) = Trr(6)(xR)
    
61.    Arr(i, 11) = Trr(7)(xR)
    
62.    Arr(i, 12) = Trr(8)(xR)
    
63.    If Arr(i, 3) > 0 Then
    
64.       XA = Trr(6)(xR) + Trr(1)(xR) - Trr(7)(xR) - Trr(8)(xR) - Arr(i, 3)
    
65.       If XA >= 0 Then XA = 0
    
66.       Else
    
67.          XA = 0
    
68.    End If
    
69.    If Trr(1)(xR) = 0 Then Arr(i, 5) = 0
    
70.    If Trr(6)(xR) = 0 Then Arr(i, 4) = 0
    
71.    If Trr(2)(xR) = 0 Then Arr(i, 3) = 0
    
72.    If Trr(5)(xR) = 0 Then Arr(i, 13) = 0
    
73.    Arr(i, 6) = XA
    
74. Next i
    
75. C = Array(, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13)
    
76. For i = 1 To UBound(C)
    
77.    Sheets(S(0)).Cells(4, C(i)).Resize(UBound(Arr), 1) = Application.Index(Arr, , C(i))
    
78. Next
    
79. MsgBox "¦@¯Ó®É¡G" & Timer - T & " ¬í"
    
80. End Sub

½Æ»s¥N½X