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

[µo°Ý] ¥H¦r¨å¤è¦¡»s§@¾lÃB©ú²Óªí

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-3-27 08:42 ½s¿è

¦^´_ 7# shuo1125


    ÁÂÁ«e½ú
¥H¤U¬O«á¾Ç½m²ßÀx¦s®æ»P°}¦C¹ï·ÓÀ³¥ÎªºRÄæ¾lÃB­pºâ¸Ñ¨M¤è®×,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub ¸ê®Æ°Ï¾lÃB()
Dim Arr, T16&, T17&, T18&, i&, S&, T$, T2$, T3$, T20$, xR As Range
'¡ô«Å§iÅܼÆ:Arr¬O³q¥Î«¬ÅܼÆ,(T16,T17,T18,i)¬Oªø¾ã¼Æ,
'(T,T2,T3,T20)¬O¦r¦êÅܼÆ

Set xR = Range([¸ê®Æ°Ï!T1], [¸ê®Æ°Ï!A1].Cells(Rows.Count, 1).End(3))
'¡ô¥OxR³oÀx¦s®æÅܼƬO ¸ê®Æ°Ï[T2]¨ì AÄæ³Ì«á¦³¤º®eÀx¦s®æ½d³òÀx¦s®æ
Arr = xR
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥H xRÀx¦s®æ­È±a¤J
For i = 1 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q1¨ì Arr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   If i = 1 Then GoTo i01
   '¡ô¦pªGiÅܼƬO 1!´N¸õ¨ì i01¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
   T2 = Arr(i, 2): T3 = Arr(i, 3): T16 = Arr(i, 16)
   T17 = Arr(i, 17): T18 = Arr(i, 18): T20 = Arr(i, 20)
   '¡ô¥OT2³o¦r¦êÅܼƬO i°j°é¦C²Ä2ÄæArr°}¦C­È,¨Ì¦¹Ãþ±À
    If Val(T16) > Val(T17) Then
    '¡ô¦pªGT16ÅܼƸgÂà¤Æªº¼Æ­È ¤j©ó T17ÅܼƸgÂà¤Æªº¼Æ­È??
       T18 = T16 - T17
       '¡ôif±ø¥ó¦¨¥ß!´N¥O T18ÅܼƬO T16 - T17ÅܼÆ
       Else
          T18 = Val(T17) - Val(T16)
          '¡ô§_«h!´N¥O T18ÅܼƬO T17ÅÜ¼Æ - T16ÅܼÆ
    End If
   If T <> T2 & "|" & T3 Then
   '¡ô¦pªGT³o¦r¦êÅÜ¼Æ ¤£µ¥©ó T2ÅܼƳs±µ T3ÅܼƲզ¨ªº·s¦r¦ê
      xR.Range("R" & i).Value = T18
      '¡ô¥OxRÅܼƪº[R2]Àx¦s®æ­È¬O T18ÅܼÆ
      T = T2 & "|" & T3
      '¡ô¥OT³o¦r¦êÅܼƬO T2ÅܼƳs±µ T3ÅܼƲզ¨ªº·s¦r¦ê
      ElseIf T20 = "¥ß±b" Then
         xR.Range("R" & i) = xR.Range("R" & i - 1) + T18
         '¡ô§_«h¥OxRÅܼƪºRÄæ(i°j°é¼Æ)¦CÀx¦s®æ­È¬O
         'xRÅܼƪºRÄæ(i°j°é¼Æ-1)¦CÀx¦s®æ­È +T18ÅܼÆ

      ElseIf T20 = "¨R±b" Then
         xR.Range("R" & i) = xR.Range("R" & i - 1) - T18
         '¡ô§_«h¥OxRÅܼƪºRÄæ(i°j°é¼Æ)¦CÀx¦s®æ­È¬O
         'xRÅܼƪºRÄæ(i°j°é¼Æ-1)¦CÀx¦s®æ­È -T18ÅܼÆ

   End If
i01:
Next
Erase Arr: Set xR = Nothing
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 23# Andy2483
Andy¤j!

1.´£¿ô«e½ú ¸ê®Æ°Ïªíªº¸ê®Æ¦b ¨t²Î¸Ì±Æ§Ç¦n¤~¼´¥X,´N¤£¥²¦bexcel±Æ§Ç
  >¦nªº¡AÁÂÁ´£¿ô...
2.­Y¦³«áÄò°ÝÃD,½Ð¤£§[¦A´£¥X,¦pªG°¾Â÷¦¹¥DÃD,½Ð¥t¶}·s¥DÃD
  >¦³®É­Ô¬O©È¯ÔÀÁ¤j®a®É¶¡¡A­Y¦³¯S§O°ÝÃD¦b´£¥X¤F..
3.½Ð«e½ú±`¤W½×¾Â¤@°_¾Ç²ß
  >§Úµ{«×¤£°÷¡A¥u¯àºCºCºN¯Á¤F...ÁÂÁ§Aªº¨ó§U!

TOP

¦^´_ 22# shuo1125


    «e½ú¦­¦w,ÁÂÁµoªí¥DÃD»P½d¨Òµ¹«á¾Ç¾Ç²ß,ÁÂÁ½׾Â
1.´£¿ô«e½ú ¸ê®Æ°Ïªíªº¸ê®Æ¦b ¨t²Î¸Ì±Æ§Ç¦n¤~¼´¥X,´N¤£¥²¦bexcel±Æ§Ç
2.­Y¦³«áÄò°ÝÃD,½Ð¤£§[¦A´£¥X,¦pªG°¾Â÷¦¹¥DÃD,½Ð¥t¶}·s¥DÃD
3.½Ð«e½ú±`¤W½×¾Â¤@°_¾Ç²ß
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 20# Andy2483
Andy¤j!
¸g´ú¸Õ¹L«á¥i¨Ï¥Î¡A·PÁ§A¹ð¦¸¨ó§U...

TOP

¦^´_ 20# Andy2483
Andy¤j¦n!
§A³o®Ä²v¤ÓÅå¤H¤F...§Ú¦³ªÅ¦A°µ´ú¸Õ¡A
ÁÙ´£¨Ñ¦hºØ¸Ñªk¤Îµù¸Ñ..ÁÂÁ§A!

TOP

¦^´_ 18# shuo1125


1.²K¥[ÅçÃÒ ¸ê®Æ°ÏÁ`¾lÃB»P ¬ì¥Ø¾lÃB©ú²Ó¦X­p¾lÃB,¤è®×¦p¤U
2.¸ê®Æ°Ï7407492§ï¬°7407491°µÅçÃÒµ²ªG¦p¤U¹Ï



Option Explicit
Sub TEST()
Application.DisplayAlerts = False
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)
Set Y = CreateObject("Scripting.Dictionary")
Z = Array(, 4, 8, 10, 12, 14, 16, 15, 17)
Brr = Sheets("¸ê®Æ°Ï").UsedRange
For i = 2 To UBound(Brr)
   T2 = Brr(i, 2): T3 = Brr(i, 3)
   S1 = T2 & "|" & T3: Y(S1 & "/b") = T2: Y(S1 & "/c") = T3
   A = Y(S1): Y(S1 & "/¾lÃB") = Brr(i, 18)
   If Not IsArray(A) Then A = Crr
   T8 = Brr(i, 8): T11 = Brr(i, 11)
   T12 = Brr(i, 12): T20 = Brr(i, 20)
   If InStr("/¨R±b/¥ß±b/", "/" & T20 & "/") = 0 Then
      Application.GoTo Sheets("¸ê®Æ°Ï").Rows(i)
      MsgBox "TÄ椣©ú ¥ß¨R±bÃþ§O": Exit Sub
   End If
   If T20 = "¨R±b" Then
      If T11 Like "#####*" = False Then
         Application.GoTo Sheets("¸ê®Æ°Ï").Rows(i)
         MsgBox "¨R±b³ÆµùÄ沧±`": Exit Sub
      End If
      If Y.Exists(T11 & "|" & T12) = Empty Then
         Application.GoTo Sheets("¸ê®Æ°Ï").Rows(i)
         MsgBox "µLªk¨R±b": Exit Sub
      End If
   End If
   If T20 = "¥ß±b" Then
      N = Y(S1 & "|r"): N = N + 1: Y(S1 & "|r") = N
      S2 = T8 & "|" & T12: Y(S2) = N
      For x = 1 To 4: A(N, x) = Brr(i, Z(x)): Next
      For x = 5 To 6
         A(N, x) = Brr(i, Z(x)) + Brr(i, Z(x + 2))
         A(N, x + 14) = A(N, x)
      Next
      Y(S1) = A: GoTo i01
   End If
   C = Format(Brr(i, 4), "M") + 6
   S2 = T11 & "|" & T12
   A(Y(S2), C) = Brr(i, 16) + Brr(i, 17)
   A(Y(S2), 20) = A(Y(S2), 20) - A(Y(S2), C)
   P = Brr(i, 14) + Brr(i, 15)
   A(Y(S2), 19) = A(Y(S2), 19) - P
   Y(S1) = A
   
i01:
Next
'====================================
For Each Yk In Y.keys
   If IsArray(Y(Yk)) Then
      On Error Resume Next
      Sheets(Val(Yk) & "").Delete
      On Error GoTo 0
      Sheets("¬ì¥Ø¾lÃBªí").Copy Before:=Sheets(1)
      With Sheets(1)
         .Name = Val(Yk)
         .UsedRange.Offset(5, 0).Delete
         With .[A5].Resize(Y(Yk & "|r"), 20)
            .Value = Y(Yk)
            Intersect([E:T], .Cells).NumberFormatLocal = _
            "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
         End With
         .[C3] = Y(Yk & "/c")
         .[C3] = .[C3] & "¡m" & Y(Yk & "/b") & "¡n"
         N = .Cells(Rows.Count, "F").End(3).Row
         With .Cells(N + 1, "F").Resize(1, 15)
            .Value = "=SUM(F5:F" & N & ")"
            If .Item(14) <> .Item(15) Then .Item(14) = "NA"
            If Y(Yk & "/¾lÃB") <> .Item(15) Then
               .Item(15)(2) = "¡ôÄY­«¿ù»~!¾lÃB¦X­p" & _
               "¤£µ¥©ó¸ê®Æ°Ï¾lÃB: " & vbLf & Y(Yk & "/¾lÃB")
               .Interior.ColorIndex = 3
               MsgBox "ÄY­«¿ù»~"
               Exit Sub
            End If

         End With
      End With
   End If
Next
Set Y = Nothing: Erase Brr, Crr, Z, A
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ 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¦X­p 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
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 17# Andy2483
Andy¤j¦n!
°w¹ï§Ú°ÝÃD·PÁ§Aªº¤j¤O¨ó§U....
§Aªºµ{§Ç½d¨ÒÀɤw¥i¨Ï¥Î¡A¦ý§Ú¥Î¦b¹ê»Ú¤W­n¨Ï¥Îªº©ú²Ó¤¤·|¥X¿ù...
³o³¡¤ÀÀ³¸Ó´N¬O§Ú¸ê®ÆÀɦۤvªº°ÝÃD...§Ú¦b·Q¿ìªk¦Û¦æ­×¥¿...
¦b¦¹·PÁ§A³Ò¤ß¤F¡AÁÂÁ±z!

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-3-22 11:18 ½s¿è

¦^´_ 16# shuo1125


    ÁÂÁ«e½ú,½Ð¸Õ¸Õ¬Ý

Option Explicit
Sub TEST()
Application.DisplayAlerts = False
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)
Set Y = CreateObject("Scripting.Dictionary")
Z = Array(, 4, 8, 10, 12, 14, 16, 15, 17)
Brr = Sheets("¸ê®Æ°Ï").UsedRange
For i = 2 To UBound(Brr)
   T2 = Brr(i, 2): T3 = Brr(i, 3)
   S1 = T2 & "|" & T3: Y(S1 & "/b") = T2: Y(S1 & "/c") = T3
   A = Y(S1)
   If Not IsArray(A) Then A = Crr
   T8 = Brr(i, 8): T11 = Brr(i, 11)
   T12 = Brr(i, 12): T20 = Brr(i, 20)
   If T20 = "¨R±b" Then
      If T11 Like "#####*" = False Then
         Application.Goto Sheets("¸ê®Æ°Ï").Rows(i)
         MsgBox "¨R±b³ÆµùÄ沧±`": Exit Sub
      End If
      If Y.Exists(T11 & "|" & T12) = Empty Then
         Application.Goto Sheets("¸ê®Æ°Ï").Rows(i)
         MsgBox "µLªk¨R±b": Exit Sub
      End If
   End If
   If T20 = "¥ß±b" Then
      N = Y(S1 & "|r"): N = N + 1: Y(S1 & "|r") = N
      S2 = T8 & "|" & T12: Y(S2) = N
      For x = 1 To 4: A(N, x) = Brr(i, Z(x)): Next
      For x = 5 To 6
         A(N, x) = Brr(i, Z(x)) + Brr(i, Z(x + 2))
         A(N, x + 14) = A(N, x)
      Next
      Y(S1) = A: GoTo i01
   End If
   C = Format(Brr(i, 4), "M") + 6
   S2 = T11 & "|" & T12
   A(Y(S2), C) = Brr(i, 16) + Brr(i, 17)
   A(Y(S2), 20) = A(Y(S2), 20) - A(Y(S2), C)
   P = Brr(i, 14) + Brr(i, 15)
   A(Y(S2), 19) = A(Y(S2), 19) - P
   Y(S1) = A
   
i01:
Next
'====================================
For Each Yk In Y.keys
   If IsArray(Y(Yk)) Then
      On Error Resume Next
      Sheets(Val(Yk) & "").Delete
      On Error GoTo 0
      Sheets("¬ì¥Ø¾lÃBªí").Copy Before:=Sheets(1)
      With Sheets(1)
         .Name = Val(Yk)
         .UsedRange.Offset(5, 0).Delete
         With .[A5].Resize(Y(Yk & "|r"), 20)
            .Value = Y(Yk)
            Intersect([E:T], .Cells).NumberFormatLocal = _
            "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
         End With
         .[C3] = Y(Yk & "/c")
         .[C3] = .[C3] & "¡m" & Y(Yk & "/b") & "¡n"
         N = .Cells(Rows.Count, "F").End(3).Row
         With .Cells(N + 1, "F").Resize(1, 15)
            .Value = "=SUM(F5:F" & N & ")"
            If .Item(14) <> .Item(15) Then .Item(14) = "NA"
            '¡ôµ²ªGªíÁ`¾lÃB¦X­p ¦pªGSÄæ<>TÄæ!´NÅýSÄæÅã¥Ü "NA"
            '§_«hSÄæ¦PTÄæ

         End With
      End With
   End If
Next
Set Y = Nothing: Erase Brr, Crr, Z, A
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ shuo1125 ©ó 2023-3-22 11:12 ½s¿è

¦^´_ 15# Andy2483
Andy¤j¦n!
¥ß¨R±bTÄ欰¤½¦¡±a¤J¡A¦]¬O§Ú§@½d¨Ò®É¶ñ¿ù²Ä16.17¦CTÄæ¤Ï¤F....«D­ì©l¨t²Î²£»s¸ê®Æ¡C
¥ß±b®É³Æµù¥i¯à·|¦³¨ä¥L½s¸¹¡A°ò¥»±ø¥ó¬°¬ì¥Ø¥N¸¹¡B³Æµù¡B¹ô§O¡B­É¶U¾l¥h§PÂ_.....
(¥u¦³¨R±b®ÉKÄæ¤~¦³·N¸q¡A¬ö¿ý¹ïÀ³ªº¶Ç²¼½s¸¹-§Ç)
¥H¤W¡AÁÂÁ§A!!

TOP

        ÀR«ä¦Û¦b : ºw¤ô¦¨ªe¡C²É¦Ì¦¨ÅÚ¡A¤Å»´¤vÆF¡A¤Å¥Hµ½¤p¦Ó¤£¬°¡C
ªð¦^¦Cªí ¤W¤@¥DÃD