- ©«¤l
- 1447
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1471
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-12-5
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-3-22 13:54 ½s¿è
¦^´_ 18# shuo1125
ÁÂÁ«e½ú¦A¦^´_
«á¾ÇÂǦ¹¥DÃD¾Ç²ß¨ì«Ü¦hª¾ÃÑ,¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú°Ñ¦Ò,½Ð¦U¦ì«e½ú«ü±Ð
¦pªGÁÙ¦³«á¾Ç¥i¥H¾Ç²ßªº!½Ð«e½úÄ~Äò´£¥X
Option Explicit
Sub TEST()
Application.DisplayAlerts = False
'¡ô¥Oµ{§Ç¹J¨ì¬O§_¯uªºn§R°£ªººÃ°Ý®É,´N¤£n¦A°Ý¤F!§R¤F¥L!
Dim Brr, A, Y, Z, Yk, T2$, T3$, T8$, T11$, T12$, T20$, S1$, S2$
Dim x%, C%, N&, i&, P&, Crr(1 To 1000, 1 To 20)
'¡ô«Å§iÅܼÆ:(Brr,A,Y,Z,Yk)¬O³q¥Î«¬ÅܼÆ,
'(T2,T3,T8,T11,T20,T12,S1,S2)¬O¦r¦êÅܼÆ,(x,C)¬Oµu¾ã¼ÆÅܼÆ,
'(N,i,P)¬Oªø¾ã¼ÆÅܼÆ,Crr¬O°}¦CÅܼÆ(Áa¦V1¨ì1000,¾î¦V1¨ì20)
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY³o³q¥Î«¬ÅܼƬO ¦r¨å
Z = Array(, 4, 8, 10, 12, 14, 16, 15, 17)
'¡ô¥OZ³o³q¥Î«¬ÅܼƬO¤@ºû°}¦C(¦@9Ó°}¦CÈ,¯Á¤Þ¸¹0¨ì8)
Brr = Sheets("¸ê®Æ°Ï").UsedRange
'¡ô¥OBrr³o³q¥Î«¬ÅܼƬO¤Gºû°}¦C,¥H¸ê®Æ°Ïªí¦³¨Ï¥ÎÀx¦s®æȱa¤J
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q2¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
T2 = Brr(i, 2): T3 = Brr(i, 3)
'¡ô¥OT2³o¦r¦êÅܼƬO i°j°é¦C²Ä2ÄæBrr°}¦CÈ,
'¥OT3³o¦r¦êÅܼƬO i°j°é¦C²Ä3ÄæBrr°}¦CÈ
S1 = T2 & "|" & T3: Y(S1 & "/b") = T2: Y(S1 & "/c") = T3
'¡ô¥OS1³o¦r¦êÅܼƬO T2ÅÜ¼Æ ³s±µ"|" ¦A³s±µT3Åܼƪº·s¦r¦ê,
'¥O¥HS1ÅÜ¼Æ ³s±µ"/b"¦¨ªº·s¦r¦ê·íkey,item¬OT2ÅܼÆ,¯Ç¤JY¦r¨å
'¥O¥HS1ÅÜ¼Æ ³s±µ"/c"¦¨ªº·s¦r¦ê·íkey,item¬OT3ÅܼÆ,¯Ç¤JY¦r¨å
A = Y(S1)
'¡ô¥OA³o³q¥Î«¬ÅܼƬO ¥HS1ÅܼƬdY¦r¨å±o¨ìªºitemÈ
If Not IsArray(A) Then A = Crr
'¡ô¦pªGAÅܼƸg§PÂ_:¤£¬O°}¦C!´N¥OAÅܼƬOCrrÅܼÆ
T8 = Brr(i, 8): T11 = Brr(i, 11)
T12 = Brr(i, 12): T20 = Brr(i, 20)
'¡ô¥OT8³o¦r¦êÅܼƬO i°j°é¦C²Ä8ÄæBrr°}¦CÈ,
'¥OT11³o¦r¦êÅܼƬO i°j°é¦C²Ä11ÄæBrr°}¦CÈ,
'¥OT12³o¦r¦êÅܼƬO i°j°é¦C²Ä12ÄæBrr°}¦CÈ
'¥OT20³o¦r¦êÅܼƬO i°j°é¦C²Ä20ÄæBrr°}¦CÈ
If InStr("/¨R±b/¥ß±b/", "/" & T20 & "/") = 0 Then
'¡ô¦pªGT20ÅܼƤ£¬O ¨R±b ,¤]¤£¬O ¥ß±b??
Application.GoTo Sheets("¸ê®Æ°Ï").Rows(i)
'¡ô¥OÀx¦s®æ´å¼Ð¸õ¨ìiÅܼƦC
MsgBox "TÄ椣©ú ¥ß¨R±bÃþ§O": Exit Sub
'¡ô¸õ¥X´£¥Üµ¡~~~:µ²§ôµ{¦¡°õ¦æ
End If
If T20 = "¨R±b" Then
'¡ô¦pªGT20ÅܼƬO "¨R±b"¦r¦ê ?
If T11 Like "#####*" = False Then
'¡ô¦pªGT11ÅܼƤ£¬O¥H5Ó³sÄò¼Æ¦r¶}ÀYªº¦r¦ê?
Application.GoTo Sheets("¸ê®Æ°Ï").Rows(i)
'¡ô¥OÀx¦s®æ´å¼Ð¸õ¨ìiÅܼƦC
MsgBox "¨R±b³ÆµùÄ沧±`": Exit Sub
'¡ô¸õ¥X´£¥Üµ¡~~~:µ²§ôµ{¦¡°õ¦æ
End If
If Y.Exists(T11 & "|" & T12) = Empty Then
'¡ô¦pªG¥HT11ÅÜ¼Æ ³s±µ"|" ¦A³s±µT12Åܼƪº·s¦r¦ê,
'¬dY¦r¨å¸Ì¨S¦³³okey??
Application.GoTo Sheets("¸ê®Æ°Ï").Rows(i)
'¡ô¥OÀx¦s®æ´å¼Ð¸õ¨ìiÅܼƦC
MsgBox "µLªk¨R±b": Exit Sub
'¡ô¸õ¥X´£¥Üµ¡~~~:µ²§ôµ{¦¡°õ¦æ
End If
End If
If T20 = "¥ß±b" Then
'¡ô¦pªGT20ÅÜ¼Æ "¥ß±b"¦r¦ê
N = Y(S1 & "|r"): N = N + 1: Y(S1 & "|r") = N
'¡ô¥ON³oªø¾ã¼ÆÅܼƬO (S1ÅܼƳs±µ"|r"¦¨ªº·s¦r¦ê)¬dY¦r¨åªºitemÈ
'¥ONÅܼƲ֥[1,
'¥O(S1ÅܼƳs±µ"|r"¦¨ªº·s¦r¦ê)ªºitemȬO NÅܼÆ
S2 = T8 & "|" & T12: Y(S2) = N
'¡ô¥OS2³o¦r¦êÅܼƬO T8ÅÜ¼Æ ³s±µ"|" ¦A³s±µT12Åܼƪº·s¦r¦ê,
'¡ô¥O¥HS2ÅܼƷíkey,item¬ONÅܼÆ,¯Ç¤JY¦r¨å¸Ì
For x = 1 To 4: A(N, x) = Brr(i, Z(x)): Next
'¡ô³]¶¶°j°é!x±q1¨ì4,¥ONÅܼƦC²ÄxÅܼÆÄæA°}¦CȬO,
'¬Oi°j°é¦C²Ä(Z°}¦C²ÄxÅܼƯÁ¤Þ¸¹È)ÄæBrr°}¦CÈ
For x = 5 To 6
'¡ô³]¶¶°j°é!x±q5¨ì6
A(N, x) = Brr(i, Z(x)) + Brr(i, Z(x + 2))
'¡ô¥ONÅܼƦC²ÄxÅܼÆÄæA°}¦CȬO,
'¬Oi°j°é¦C²Ä(Z°}¦C²ÄxÅܼƯÁ¤Þ¸¹È)ÄæBrr°}¦CÈ+
'i°j°é¦C²Ä(Z°}¦C(²ÄxÅܼÆ+2)¯Á¤Þ¸¹È)ÄæBrr°}¦CÈ
A(N, x + 14) = A(N, x)
'¡ô¥ONÅܼƦC²Ä(xÅܼÆ+14)ÄæA°}¦CȬO NÅܼƦC²ÄxÅܼÆÄæA°}¦CÈ
Next
Y(S1) = A: GoTo i01
'¡ô¥O¥HS1ÅܼƬ°key,item¬OA°}¦C,¯Ç¤JY¦r¨å(«½Ækey«h¨ú¥N¨äitem),
'¸õ¨ì i01¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
End If
C = Format(Brr(i, 4), "M") + 6
'¡ô¥OC³oµu¾ã¼ÆÅܼƬO i°j°é¦C²Ä4ÄæBrr°}¦CȨú¨ä¤é´Á¤ë¥÷«áÂà¼Æ¦r+6
S2 = T11 & "|" & T12
'¡ô¥OS2ÅܼƬO T11ÅÜ¼Æ ³s±µ"|" ¦A³s±µT12Åܼƪº·s¦r¦ê
A(Y(S2), C) = Brr(i, 16) + Brr(i, 17)
'¡ô¥O(S2ÅܼƷíkey¬dY¦r¨åitemÈ)¦C²ÄCÅܼÆÄæA°}¦CȬO,
'¬Oi°j°é¦C²Ä16ÄæBrr°}¦CÈ + i°j°é¦C²Ä17ÄæBrr°}¦CÈÄæBrr°}¦CÈ
A(Y(S2), 20) = A(Y(S2), 20) - A(Y(S2), C)
'¡ô¥O(S2ÅܼƷíkey¬dY¦r¨åitemÈ)¦C²Ä20ÄæA°}¦CȬO,
'¬O¦Û¨°}¦CÈ - (S2ÅܼƷíkey¬dY¦r¨åitemÈ)¦C²ÄCÅܼÆÄæA°}¦CÈ
P = Brr(i, 14) + Brr(i, 15)
'¡ô¥OP³oªø¾ã¼Æ¬O i°j°é¦C14ÄæBrr°}¦CÈ + i°j°é¦C15ÄæBrr°}¦CÈ
A(Y(S2), 19) = A(Y(S2), 19) - P
'¡ô¥O(S2ÅܼƷíkey¬dY¦r¨åitemÈ)¦C²Ä19ÄæA°}¦CȬO,
'¬O¦Û¨°}¦CÈ - PÅܼÆ
Y(S1) = A
'¡ô¥O¥HS1ÅܼƬ°key,item¬OA°}¦C,¯Ç¤JY¦r¨å(«½Ækey«h¨ú¥N¨äitem)
i01:
Next
'====================================
For Each Yk In Y.keys
'¡ô³]³v¶µ°j°é!¥OYk³o³q¥Î«¬ÅܼƬOY¦r¨å¸Ìkey¤§¤@
If IsArray(Y(Yk)) Then
'¡ô¦pªG¥H YkÅܼƬdY¦r¨åªºitemȬO °}¦C?
On Error Resume Next
'¡ô¥Oµ{§Ç¹J¿ù¸õ¹L!¨ÃÄ~Äò°õ¦æ
Sheets(Val(Yk) & "").Delete
'¡ô¥O¥HYkÅܼÆÂন¼ÆȦA³s±µªÅ¦r¤¸ªº·s¦r¦êªº¦W¦r,
'¥H¦¹¦r¦ê¦W¦rªº¤u§@ªí§R°£
On Error GoTo 0
'¡ô¥Oµ{§Ç«ì´_¥¿±`°»¿ù
Sheets("¬ì¥Ø¾lÃBªí").Copy Before:=Sheets(1)
'¡ô¥O¬ì¥Ø¾lÃBªí¥t¥~½Æ»s¤@Ó¦P¼Ëªí©ñ¦b³Ì«e±
With Sheets(1)
'¡ô¥H¤U¬OÃö©ó ³Ì«e±³o¤u§@ªíªºµ{§Ç
.Name = Val(Yk)
'¡ô¥O¦W¦r§ï¬°YkÅܼÆÂà¤Æ¬°¼Æ¦rªº¦r¦ê
.UsedRange.Offset(5, 0).Delete
'¡ô¥O¦³¨Ï¥ÎªºÀx¦s®æ½d³ò¦V¤U°¾²¾5¦Cªº½d³ò§R°£
With .[A5].Resize(Y(Yk & "|r"), 20)
'¡ô¥H¤U¬OÃö©óªí¸Ì[A5]ÂX®i¦V¤UY(Yk & "|r")¦C,¦V¥k20Äæ½d³ò
'Ãö©ó³o½d³òÀx¦s®æªºµ{§Ç
'Y(Yk & "|r"):¬O¥HYkÅÜ¼Æ ³s±µ"|r"ªº·s¦r¦ê¬dY¦r¨åªºitemÈ
.Value = Y(Yk)
'¡ô¥OÀx¦s®æȬO ¥HYkÅܼƬdY¦r¨å±o¨ìªº°}¦CÈ
Intersect([E:T], .Cells).NumberFormatLocal = _
"_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
'¡ô¥O[E:T]»P¦¹½d³òÀx¦s®æ¥æ¶°ªº½d³òÀx¦s®æ®æ¦¡¬O"~~~~~"
End With
.[C3] = Y(Yk & "/c")
'¡ô¥Oªí¸Ì[C3]Àx¦s®æȬO ¥HYk ³s±µ"/c"¦r¦ê¦¨ªº·s¦r¦ê,
'¦¹¦r¦ê¬dY¦r¨å±o¨ìªº itemÈ
.[C3] = .[C3] & "¡m" & Y(Yk & "/b") & "¡n"
'¡ô¥Oªí¸Ì[C3]Àx¦s®æȬO ¦Û¨¦r¦ê ³s±µ"¡m",
'¦A³s±µ ¥HYk ³s±µ"/c"¦r¦ê¦¨ªº·s¦r¦ê,³Ì«á³s±µ"¡n" ¦¨ªº·s¦r¦ê
N = .Cells(Rows.Count, "F").End(3).Row
'¡ô¥ONÅܼƬOFÄæ³Ì«á¦³¤º®eÀx¦s®æ¦C¸¹
With .Cells(N + 1, "F").Resize(1, 15)
'¡ô¥H¤U¬O Ãö©óªí¸Ì(NÅܼÆ+1)¦CFÄæÀx¦s®æÂX®i¦V¥k15Ä檺µ{§Ç
.Value = "=SUM(F5:F" & N & ")"
'¡ô¥O³o¨ÇÀx¦s®æȬO "=SUM(F5:F" ³s±µNÅÜ¼Æ ¦A³s±µ")",
'¦¹³s±µ¦¨ªº·s¦r¦ê©ñ¤J¦UÀx¦s®æ«á·|¦]¬°³Ì«e±ªº"="²Å¸¹,
'¸Ì±ªºÄæ¦ì²Å¸¹·|ÀH¦U¤£¦PÄæ¦ì°µÅܤÆ
If .Item(14) <> .Item(15) Then .Item(14) = "NA"
'¡ô¦pªGµ²ªGªíÁ`¾lÃB¦Xp SÄæ<>TÄæ!´NÅýSÄæÅã¥Ü "NA"
'§_«hSÄæ¦PTÄæ
End With
End With
End If
Next
Set Y = Nothing: Erase Brr, Crr, Z, A
'¡ô¥OÄÀ©ñÅܼÆ
End Sub |
|