mdr0465

¦^´_ 10# ­ã´£³¡ªL

­ã´£³¡ªL, ÁÂÁ§A´£¨Ñ³o»ò¦hªº½d¨Ò, ¹ê¦b¤Ó¦³¥Î¤F, «á¾Ç©w¥²²Ó¤ß¾Ç²ß,ÁÂÁÂ

Andy2483

¦^´_ 10# ­ã´£³¡ªL


    ÁÂÁ½׾Â,ÁÂÁ«e½ú«ü¾É
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú¦A«ü¾É

¤@ºûÂà¤Gºû_Xl0000016½d¨Ò
°õ¦æ«e:

¤U¸ü (119.06 KB)

2023-5-5 10:12

°õ¦æµ²ªG:

¤U¸ü (158.91 KB)

2023-5-5 10:12

Option Explicit
Sub TEST()
Dim Brr, Y, R&, C%, Nr&, Nc%, i&, T1$, T2$, Sh As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sh = Sheet1: Brr = Sh.[A1].CurrentRegion
ReDim Crr(1 To UBound(Brr), 1 To 200)
For i = 1 To UBound(Brr)
   T1 = Brr(i, 1): T2 = Brr(i, 2): T2 = Left(T2, 2) & Format(Mid(T2, 3), "00")
   If i = 1 Then: R = R + 1: C = C + 1: Crr(R, 1) = T1 & "\" & T2: GoTo i01
   If Y(T1) = "" Then R = R + 1: Y(T1) = R: Crr(R, 1) = T1
   If Y(T2) = "" Then C = C + 1: Y(T2) = C: Crr(1, C) = T2
   Nr = Y(T1): Nc = Y(T2): Crr(Nr, Nc) = Crr(Nr, Nc) + Brr(i, 3)
i01: Next
Sh.[F1].CurrentRegion.EntireColumn.Clear
With Sh.[F1].Resize(R, C)
   .Value = Crr
   .Sort Key1:=.Item(1), Order1:=1, Header:=1, Orientation:=1
   .Offset(0, 1).Sort Key1:=.Item(1), Order1:=1, Header:=1, Orientation:=2
   .Item(R + 1, 1) = "TOTAL": .Item(1, C + 1) = "TOTAL"
   .Item(R + 1, 2).Resize(1, C) = "=SUM(G2:G" & R & ")"
   .Item(2, C + 1).Resize(R - 1, 1) = "=SUM(RC[" & -C + 1 & "]:RC[-1])"
   .EntireColumn.AutoFit
   .Borders.LineStyle = 1
End With
With Sh.[F1].CurrentRegion
   .Borders.LineStyle = 1
   Union(.Rows(1), .Rows(R + 1), .Columns(1), .Columns(C + 1)).Font.Bold = True
End With
Set Y = Nothing: Erase Brr, Crr
End Sub

Andy2483

¦^´_ 10# ­ã´£³¡ªL


    ÁÂÁ½׾Â,ÁÂÁ«e½ú«ü¾É
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú¦A«ü¾É

¤@ºûÂà¤Gºû_Xl0000016½d¨Ò,¦b¦r¨å¤¤°µ¦X­pªº¾Ç²ß¤è®×

Option Explicit
Sub TEST_1()
Dim Brr, Y, R&, C%, Nr&, Nc%, i&, j%, T1$, T2$, Sh As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sh = Sheet1: Brr = Sh.[A1].CurrentRegion
ReDim Crr(1 To UBound(Brr), 1 To 200)
For i = 1 To UBound(Brr)
   T1 = Brr(i, 1): T2 = Brr(i, 2): T2 = Left(T2, 2) & Format(Mid(T2, 3), "00")
   If i = 1 Then: R = R + 1: C = C + 1: Crr(R, 1) = T1 & "\" & T2: GoTo i01
   If Y(T1) = "" Then R = R + 1: Y(T1) = R: Crr(R, 1) = T1
   If Y(T2) = "" Then C = C + 1: Y(T2) = C: Crr(1, C) = T2
   Y(T1 & "|r") = Y(T1 & "|r") + Brr(i, 3): Y(T2 & "|c") = Y(T2 & "|c") + Brr(i, 3)
   Nr = Y(T1): Nc = Y(T2): Crr(Nr, Nc) = Crr(Nr, Nc) + Brr(i, 3): Y("|Tt") = Y("|Tt") + Brr(i, 3)
   If i = UBound(Brr) Then
      For j = 2 To R: Crr(Y(Crr(j, 1)), C + 1) = Y(Crr(j, 1) & "|r"): Next
      For j = 2 To C: Crr(R + 1, Y(Crr(1, j))) = Y(Crr(1, j) & "|c"): Next
      Crr(R + 1, C + 1) = Y("|Tt")
   End If
i01: Next
Sh.[F1].CurrentRegion.EntireColumn.Clear
With Sh.[F1].Resize(R + 1, C + 1)
   .Value = Crr
   .Sort Key1:=.Item(1), Order1:=1, Header:=1, Orientation:=1
   .Offset(0, 1).Sort Key1:=.Item(1), Order1:=1, Header:=1, Orientation:=2
   Union(.Item(R + 1, 1), .Item(1, C + 1)) = "TOTAL"
   .EntireColumn.AutoFit: .Borders.LineStyle = 1
   Union(.Rows(1), .Rows(R + 1), .Columns(1), .Columns(C + 1)).Font.Bold = True
End With
Set Y = Nothing: Set Sh = Nothing: Erase Brr, Crr
End Sub

gaishutsusuru

¦^´_ 6# ­ã´£³¡ªL

ÁÂÁ«e½úÀ°¦£¡C

¥t¥~¡A·Q½Ð±Ð«e½ú¡A§Ú¸ÕµÛ±N±zªºÀɮתºSheet1ªºA1~F9ªº¸ê®Æ½Æ»s°_¨Ó¡A¥t¥~¦A«Ø¤@­Ó·sÀɨӴú¸Õ¥¨¶°¡C
µ²ªG·|¸õ¿ù»~°T®§¡G°õ¦æ¶¥¬q¿ù»~'424'¡A¦¹³B»Ý­nª«¥ó¡C
¦Ó°»¿ù®É¬O¡uArr = Sheet1.[a1].CurrentRegion¡v³o¦æ¥X²{°ÝÃD¡C

½Ð°Ý¬O­þ­Ó¨BÆJ¾Þ§@¿ù»~©O? ¸Ó¦p¦ó³B²z©O? ÁÂÁ«e½ú

Andy2483

¦^´_ 14# gaishutsusuru
¦^´_ 6# ­ã´£³¡ªL


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
ÁÂÁ ­ã´£³¡ªL«e½ú«ü¾É
«á¾ÇÂǦ¹©«¾Ç²ß«e½úªº¤è®×,¤è®×¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É

¸ê®Æªí:

¤U¸ü (39.28 KB)

2023-5-11 09:15

µ²ªGªí:

¤U¸ü (22.5 KB)

2023-5-11 09:15

Sub TEST_A1()
Dim Arr, Brr, xD, xD2, M&, V&, R&, i&, j%, C%, Cn%, T$
'¡ô«Å§iÅܼÆ:(Arr,Brr,xD,xD2)¬O³q¥Î«¬ÅܼÆ,(M,V,R,i)¬Oªø¾ã¼Æ,
'(j,C,Cn)¬Oµu¾ã¼Æ,T¬O¦r¦êÅܼÆ
Set xD = CreateObject("Scripting.Dictionary")
Set xD2 = CreateObject("Scripting.Dictionary")
'¡ô¦U¥O(xD,xD2)¬O¦r¨å
Arr = Sheet1.[a1].CurrentRegion
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥Hªí1ªº[A1]¦ê¨ÃÁp«áÂX®i³Ì¤p¤è¥¿½d³ò,
'³Ì¤p¤è¥¿½d³òÀx¦s®æ­È±a¤JArr°}¦C¤¤
ReDim Brr(1 To UBound(Arr), 1 To 250)
'¡ô«Å§iBrr³o³q¥Î«¬ÅܼƬO¤GºûªÅ°}¦C,Áa¦V½d³ò:1¨ìArr°}¦C³Ì¤j¯Á¤Þ¦C¸¹,
'¾î¦V½d³ò±q1 ¨ì250
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q2 ¨ìArr°}¦C³Ì¤j¯Á¤Þ¦C¸¹
    M = Arr(i, 1): V = Arr(i, 6): T = ""
    '¡ô¥OM³oªø¾ã¼ÆÅܼƬO i°j°é¦C²Ä1ÄæArr°}¦C­È,
    '¥OV³oªø¾ã¼ÆÅܼƬO i°j°é¦C²Ä6ÄæArr°}¦C­È,¥OT³o¦r¦êÅܼƬO ªÅ¦r¤¸
    For j = 2 To 5
    '¡ô³]¶¶°j°é!j±q2 ¨ì5
       T = T & "|" & Arr(i, j) '|¼t§O|¼t§O½s¸¹|¥N¸¹|¦WºÙ
       '¡ô¥OTÅܼƬO¦Û¨­³s±µ"|"²Å¸¹¦A³s±µ,
       '³s±µi°j°é¦C²Äj°j°éÄæArr°}¦C­È©Ò²Õ¦¨ªº·s¦r¦ê
    Next
    If Not xD.Exists(T) Then
    '¡ô¦pªG¥HTÅܼƬdxD¦r¨å¸Ì¨S¦³³o­Ókey?
       Set xD(T) = CreateObject("Scripting.Dictionary")
       '¡ô¥O¥HTÅܼƷíkey,item¬O¦r¨å,¯Ç¤JxD¦r¨å¸Ì (¦r¨å¤¤ªº¦r¨å)
       R = R + 1
       '¡ô¥OR³oªø¾ã¼ÆÅÜ¼Æ ²Ö¥[1 (PS:Rªø¾ã¼ÆÅܼƪºªì©l­È¬O0)
       For j = 1 To 4
       '¡ô³]¶¶°j°é!j±q1 ¨ì4
           Brr(R + 1, j) = Arr(i, j + 1)
           '¡ô¥O(RÅܼÆ+1)¦C²ÄjÅܼÆÄæBrr°}¦C­È¬O ,
           '¬O i°j°é¦C²Ä(j°j°é+1)ÄæArr°}¦C­È
           If R = 1 Then Brr(1, j) = Arr(1, j + 1)
           '¡ô¦pªGRÅܼƬO 1!´N¥O²Ä1¦Cj°j°éÄæBrr°}¦C­È¬O ,
           '¬O ²Ä1¦C²Ä(jÅܼÆ+1)ÄæArr°}¦C­È (³B²z¼ÐÃD¦C)
       Next
    End If
    If M > xD2(T & -1) Then
    '¡ô¦pªGMÅܼƤj©ó ¥H(TÅܼƳs±µ"-1"©Ò²Õ¦¨·s¦r¦ê)¬dxD2¦r¨å¦^¶Çitem­È
       xD2(T & -1) = M  '(¤ë¤é)
       '¡ô¥O¥H(TÅܼƳs±µ"-1"©Ò²Õ¦¨·s¦r¦ê)·íkey,
       'item­È¬O MÅܼÆ,¯Ç¤JxD2¦r¨å
       xD2(T) = V '(»ù®æ)
       '¡ô¥O¥H TÅܼƷíkey,item­È¬O VÅܼÆ,¯Ç¤JxD2¦r¨å
    End If
    xD(T)(V) = ""
    '¡ô¥O¥H VÅܼÆ(»ù®æ)·íkey,item¬OªÅ¦r¤¸¯Ç¤J TÅܼƪº¦r¨å¸Ì
Next i
'-----------------------------------
For i = 1 To R
'¡ô³]¶¶°j°é!i±q2 ¨ìRÅܼÆ(¤l¦r¨åªº¼Æ¶q)
    T = xD.keys()(i - 1)
    '¡ô¥OTÅܼƬO xD¦r¨å¸Ìªº²Ä(iÅܼÆ-1)¯Á¤Þ¸¹key
    V = xD2(T)
    '¡ô¥OVÅܼƬO TÅܼƬdxD2¦r¨å¦^¶Çitem­È(»ù®æ)
    Brr(i + 1, 5) = V
    '¡ô¥O(i°j°é+1)¦C²Ä5ÄæBrr°}¦C­È¬O VÅܼÆ
    xD(T).Remove V
    '¡ô¥OTÅܼƤl¦r¨å¸Ìªº VÅܼÆkey²¾°£
    Cn = xD(T).Count
    '¡ô¥OCn³oµu¾ã¼ÆÅܼƬO TÅܼƤl¦r¨å¸Ìkeyªº¼Æ¶q
    If Cn > C Then C = Cn
    '¡ô¦pªGCnÅܼƤj©óC³oµu¾ã¼ÆÅܼÆ!´N¥OCÅܼƬO CnÅܼÆ
    For j = 1 To Cn
    '¡ô³]¶¶°j°é!j±q1 ¨ìCnÅܼÆ
        Brr(i + 1, j + 5) = Application.Large(xD(T).keys, j)
        '¡ô¥O¾ú¥v»ù¥ª¦Ü¥k¥Ñ¤j¨ì¤p¼g¤JBrr°}¦C¸Ì
    Next j
Next i
For j = 1 To C: Brr(1, j + 5) = "¾ú¥v»ù" & j: Next
'¡ô¥O³]¶¶°j°é³B²z ¾ú¥v»ù ªº¼ÐÃD¦C
Brr(1, 5) = "²{¦æ»ù"
'¡ô¼ÐÃD¦Cªº²{¦æ»ù©ïÀY
'---------------------------------
Sheet2.UsedRange.ClearContents
'¡ô¥Oµ²ªGªí¸ê®Æ²M°£¤º®e
Sheet2.[a1].Resize(R + 1, C + 5) = Brr
'¡ô¥OBrr°}¦C­È¼g¤Jµ²ªGªí[A1]¶}©lªººë½T½d³ò
End Sub

­ã´£³¡ªL

¦^´_ 14# gaishutsusuru

§ï³o¼Ë¸Õ¸Õ~~
Arr = Sheets("¤u§@ªí¦WºÙ").[a1].CurrentRegion

gaishutsusuru

¦^´_ 16# ­ã´£³¡ªL

ÁÂÁ«e½úÀ°¦£

gaishutsusuru

¦^´_ 15# Andy2483

¤]ÁÂÁ«e½ú°w¹ïµ{¦¡½X°µ¦p¦¹¥J²Óªº¤ÀªR¡C