- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-10-21 12:00 ½s¿è
¦^´_ 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¦Xp
'¡ô±N°}¦CÈ·íITEM,KEY¬O0~9 ˤJ ¯Srr(1)³o¦r¨å¤¤ªº¦r¨å
'¡ô¦r¨å¤¤ªº¦r¨åKEY 0 ªºITEM ¬O"" ªÅ¦r¤¸,¬O«á±µ{§Ç¨S¦³¥Î¨ìªº
'¯Âºé¬OnÅý«á±µ{§Ç±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)
'¡õ«áÄò¨Ì¤WzÃþ±À, ¸Ì±ªº 99 ¬OCUÄ檺·N«ä
¯Srr(2) = Array("", 2, 18, 2, 15, 0, 1, 2, 19, "AÜ") '¥X®w¦Xp
¯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 |
|