Andy2483

¦^´_ 3# 198188


    ÁÂÁ½׾Â,ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò
20231107_2.zip (33.51 KB)

11/07­×¥¿ª©
¤U¸ü¦¸¼Æ: 4

2023-11-7 07:57

°õ¦æ«e:

¤U¸ü (65.51 KB)

2023-11-6 14:30

°õ¦æµ²ªG:

¤U¸ü (121.02 KB)

2023-11-6 14:30

Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, Z, i&, j%, R&, c%, N&, T$, T2$, T3$, T4$
Set Z = CreateObject("Scripting.Dictionary")
c = Sheets(1).[IV1].End(xlToLeft).Column
Brr = Range(Sheets(1).Cells(1, c), Sheets(1).[A65536].End(3))
Crr = Range(Sheets(2).[G1], Sheets(2).[A65536].End(3))
ReDim Arr(1 To UBound(Crr), 1 To c)
For i = 2 To UBound(Brr): Z(Trim(Brr(i, 1)) & "/r") = i: Next
For i = 2 To UBound(Crr)
   R = Z(Crr(i, 1))
   If R = 0 Then N = N + 1: R = N: Arr(N, 1) = Crr(i, 1): Z(Crr(i, 1)) = R
   T = Trim(Crr(i, 7))
   For j = 2 To UBound(Brr, 2)
      If Z(T & "/r") = "" Then Arr(R, j) = 0 Else Arr(R, j) = Arr(R, j) + Brr(Z(T & "/r"), j)
   Next
Next
If R = 0 Then Exit Sub
With Sheets(3)
   T2 = .[A65536].End(3): T3 = Left(.[B1], 5)
   T4 = .[A65536].End(3)(0): .UsedRange.Clear
   With .[A2].Resize(R, UBound(Arr, 2))
      .Value = Arr: .Sort KEY1:=.Item(1), Order1:=1, Header:=2
   End With
   For j = 1 To c: Brr(1, j) = T3 & Brr(1, j): Next
   .[A1].Resize(1, c) = Brr: .[A1] = Sheets(2).[A1]
   .Cells(R + 2, 1) = T4: .Cells(R + 3, 1) = T2
   .Cells(R + 3, 2).Resize(1, c - 1).Value = "=SUM(B2:B" & R + 1 & ")"
   Union(.[1:1], .Rows(R + 3)).Font.Bold = True: Application.Goto .[A1]
End With
Set Z = Nothing: Erase Brr, Crr, Arr
End Sub

Andy2483

¦^´_ 6# 198188


   
If Z(T & "/r") = "" Then Arr(R, j) = 0 Else Arr(R, j) = Arr(R, j) + Brr(Z(T & "/r"), j) * VaL(Crr(i, 3))

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾Ç­q¥¿½Æ²ß¤ß±oµù¸Ñ¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, Z, i&, R&, N&, j%, c%, T$, T2$, T3$, T4$
'¡ô«Å§iÅܼÆ:(Arr,Brr,Crr,Z)¬O³q¥Î«¬ÅܼÆ,(i,R,N)¬Oªø¾ã¼ÆÅܼÆ,(j,c)¬Oµu¾ã¼ÆÅܼÆ,
'(T,T2,T3,T4)¬O¦r¦êÅܼÆ
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZ³o³q¥Î«¬ÅܼƬO ¦r¨å
c = Sheets(1).[IV1].End(xlToLeft).Column
'¡ô¥Oc³oµu¾ã¼ÆÅܼƬO ²Ä1ªí²Ä1¦C³Ì¥k°¼¦³¤º®eªº¯Á¤ÞÄ渹
Brr = Range(Sheets(1).Cells(1, c), Sheets(1).[A65536].End(3))
'¡ô¥OBrr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥H½d³òÀx¦s®æ­È±a¤J:
'²Ä1ªícÅܼÆÄæ²Ä1¦CÀx¦s®æ¨ì ²Ä1ªíAÄæ³Ì«á¦³¤º®eÀx¦s®æ
Crr = Range(Sheets(2).[G1], Sheets(2).[A65536].End(3))
'¡ô¥OCrr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥H½d³òÀx¦s®æ­È±a¤J:
'²Ä2ªí[G1]Àx¦s®æ¨ì ²Ä2ªíAÄæ³Ì«á¦³¤º®eÀx¦s®æ
ReDim Arr(1 To UBound(Crr), 1 To c)
'¡ô«Å§iArr³o³q¥Î«¬ÅܼƬO ¤GºûªÅ°}¦C,Áa¦V½d³ò¯Á¤Þ¸¹1¨ìCrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹,
'¾î¦V½d³ò1¨ì cÅÜ¼Æ ¯Á¤ÞÄ渹
For i = 2 To UBound(Brr): Z(Trim(Brr(i, 1)) & "/r") = i: Next
'¡ô³]¶¶°j°é!i±q2 ¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
'¡ô¥Oi°j°é¦C1ÄæBrr°}¦C­È¥h°£ÀY§ÀªÅ¦r¤¸,³s±µ"/r"²Õ¦¨ªº¦r¦ê·íkey,
'item¬OiÅܼÆ,¯Ç¤JZ¦r¨å¤¤
For i = 2 To UBound(Crr)
'¡ô³]¶¶°j°é!i±q2 ¨ìCrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   R = Z(Trim(Crr(i, 1)))
   '¡ô¥OR³oªø¾ã¼ÆÅܼƬO¥H i°j°é¦C1ÄæCrr°}¦C­È¥h°£ÀY§ÀªÅ¦r¤¸ ¦r¦ê,
   '¬dZ¦r¨å¦^¶ÇItem­È
   If R = 0 Then N = N + 1: R = N: Arr(N, 1) = Crr(i, 1): Z(Trim(Crr(i, 1))) = R
   '¡ô¦pªGRÅܼƬO0!´N¥ON³oªø¾ã¼Æ²Ö¥[1,¥ORÅܼƦPNÅܼƭÈ,
   '¥ONÅܼƦC1ÄæArr°}¦C­È¬O i°j°é¦C1ÄæCrr°}¦C­È
   '¥Oi°j°é¦C1ÄæCrr°}¦C­È¥h°£ÀY§ÀªÅ¦r¤¸ ¦r¦ê·íkey,RÅܼƭȷíitem ¯Ç¤JZ¦r¨å¸Ì
   T = Trim(Crr(i, 7))
   '¡ô¥OT³o¦r¦êÅܼƬO i°j°é¦C7ÄæCrr°}¦C­È¥h°£ÀY§ÀªÅ¦r¤¸ ¦r¦ê
   For j = 2 To UBound(Brr, 2)
   '¡ô³]¶¶°j°é!j±q2 ¨ìBrr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹
      If Z(T & "/r") = "" Then Arr(R, j) = 0 Else Arr(R, j) = Arr(R, j) + Brr(Z(T & "/r"), j) * Val(Crr(i, 3))
      '¡ô¦pªG¥HTÅܼƳs±µ"/r"²Õ¦¨ªº·s¦r¦ê¬dZ¦r¨å¦^¶Çitem¬OªÅ¦r¤¸,
      '´N¥ORÅܼƦCjÅܼÆÄæArr°}¦C­È¬O0
      '§_«h´N¥ORÅܼƦCjÅܼÆÄæArr°}¦C­È¬O ²Ö¥[(Brr°}¦C­È* i°j°é¦C3ÄæCrr°}¦C­È)
      'Brr°}¦C­È:(TÅܼƳs±µ"/r"²Õ¦¨ªº·s¦r¦ê¬dZ¦r¨å¦^¶Çitem)¦C,jÅܼÆÄæBrr°}¦C­È
   Next
Next
If R = 0 Then MsgBox "¨S¦³²Å¦Xªº¸ê®Æ": Exit Sub
'¡ô¦pªGRÅܼƬO0!´N¸õ¥X´£µøµ¡~~~,µ²§ôµ{¦¡°õ¦æ
With Sheets(3)
'¡ô¥H¤U¬OÃö©ó²Ä3ªíªºµ{§Ç
   T2 = .[A65536].End(3): T3 = Left(.[B1], 5)
   '¡ô¥OT2³o¦r¦êÅܼƬOAÄæ³Ì«á¦³¤º®eÀx¦s®æ¦r¦ê
   '¡ô¥OT3³o¦r¦êÅܼƬO[B1]Àx¦s®æ¥ª°¼5­Ó¦r¤¸
   T4 = .[A65536].End(3)(0): .UsedRange.Clear
   '¡ô¥OT4³o¦r¦êÅܼƬO AÄæ³Ì«á¦³¤º®eÀx¦s®æ«e¤@®æ¦r¦ê
   With .[A2].Resize(R, UBound(Arr, 2))
   '¡ô¥H¤U¬OÃö©ó²Ä3ªí[A2]ÂX®i¦V¤URÅܼƦC,ÂX®i¦V¥k(Arr¾î¦V³Ì¤j¯Á¤ÞÄ渹)Äæ,
   'Ãö©ó¦¹½d³òÀx¦s®æªºµ{§Ç
      .Value = Arr: .Sort KEY1:=.Item(1), Order1:=1, Header:=2
      '¡ô¥O¦¹½d³òÀx¦s®æ­È¥HArr°}¦C±a¤J
      '¡ô¥O¦¹½d³òÀx¦s®æ°µ²Ä1Ä欰°ò·ÇªºµL¼ÐÃDº¥¼W±Æ§Ç
   End With
   For j = 1 To c: Brr(1, j) = T3 & Brr(1, j): Next
   '¡ô³]¶¶°j°é!j±q1¨ìcÅܼÆ
   '¥O²Ä1¦Cj°j°éÄæBrr°}¦C­È¬O T3ÅܼƳs±µ¦Û¨­°}¦C­È²Õ¦X¦¨ªº·s¦r¦ê
   .[A1].Resize(1, c) = Brr: .[A1] = Sheets(2).[A1]
   '¡ô¥O²Ä3ªí[A1]ÂX®i¦V¥kcÅܼÆÄæ½d³òÀx¦s®æ­È ¥HBrr°}¦C­È±a¤J
   '¡ô¥O²Ä3ªí[A1]Àx¦s®æ­È¦P ²Ä2ªí[A1]Àx¦s®æ­È
   .Cells(R + 2, 1) = T4: .Cells(R + 3, 1) = T2
   '¡ô¥O²Ä3ªíAÄæ(RÅܼÆ+2)¦CÀx¦s®æ¬O T2ÅܼÆ
   .Cells(R + 3, 2).Resize(1, c - 1).Value = "=SUM(B2:B" & R + 1 & ")"
   '¡ô¥O²Ä3ªíBÄæ(RÅܼÆ+3)¦CÀx¦s®æÂX®i¦V¥k(cÅܼÆ-1)Äæ½d³òÀx¦s®æ­È¬O¤½¦¡
   '¤½¦¡:SUM()¥[Á` B2¨ìBÄæ(RÅܼÆ+1)¦C
   'C~FÄ椽¦¡·|¦Û°ÊÅܤÆ
   Union(.[1:1], .Rows(R + 3)).Font.Bold = True: Application.Goto .[A1]
   '¡ô¥O²Ä1¦C»P³Ì«á¦CÀx¦s®æ¦rÅ鬰²ÊÅé
   '¡ô¥O´å¼Ð¸õ¨ì²Ä3ªí[A1]Àx¦s®æ
End With
Set Z = Nothing: Erase Brr, Crr, Arr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub