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

[µo°Ý] ¸ê®ÆÂà¸m¨D§U«e½ú

·PÁ¦U¤è«e½ú«üÂI,¦¬¤UºCºC¾Ç²ß.
§ù¤p¥­

TOP

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


    ÁÂÁ½׾Â,ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß«e½úªº¤è®×,¤è®×¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É

°õ¦æ«e:
20230602_1.jpg
2023-6-2 13:14


°õ¦æµ²ªG:
20230602_2.jpg
2023-6-2 13:15



Sub Âà¸m()
Dim Arr, Brr, C%(2), r%, j%, i&
'¡ô«Å§iÅܼÆ:(Arr,Brr)¬O³q¥Î«¬ÅܼÆ,C¬Oµu¾ã¼Æ­Èªº¤@ºû°}¦C(0~2)
'(r,j)¬Oµu¾ã¼Æ,i¬Oªø¾ã¼Æ
ActiveSheet.UsedRange.Offset(, 7).EntireColumn.Delete
'¡ô¥O¨Ï¥ÎªºÀx¦s®æ©¹¥k°¾²¾7Äæ½d³òÀx¦s®æ©Ò¦bªºÄæ¦ì§R°£
Arr = Range([a3], [c65536].End(3))
'¡ô¥OArrÅܼƬO ¤Gºû°}¦C,¥H[A3]¨ìCÄæ³Ì«á¤@­Ó¦³¤º®eÀx¦s®æ­È±a¤J
ReDim Brr(1 To 8, 1 To 200)
'¡ô¥OBrrÅܼƬO ¤GºûªÅ°}¦C,Áa¦V½d³ò1~8,¾î¦V½d³ò1~200
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é
    r = IIf(Arr(i, 1) > 6, 1, 0):  C(r) = C(r) + 1
    '¡ô¥OrÅܼƬOIIf()¦^¶Ç­È,¦pªG²Ä1ÄæArr°}¦C­È ¤j©ó6,¦^¶Ç1,§_«h0
    '¡ô¥Or¯Á¤Þ¸¹ªºC°}¦C­È²Ö¥[1

    For j = 1 To 3
    '¡ô³]¶¶°j°é
        Brr(r * 4 + j, C(r)) = Arr(i, j)
        '¡ô¥OArr°}¦C­È¼g¤JBrr°}¦C«ü©w¦ì¸m¸Ì
    Next j
    If C(r) > C(2) Then C(2) = C(r)
    '¡ô¦pªGrÅܼƯÁ¤Þ¸¹C°}¦C­È¤j©ó 2¯Á¤Þ¸¹C°}¦C­È,
    '´N¥O2¯Á¤Þ¸¹C°}¦C­È¬O rÅܼƯÁ¤Þ¸¹C°}¦C­È
    'C(2)¬O¬°¤F­pºâ°}¦C³Ì¤j»Ý¨DÄæ¼Æ

Next i
With [h2].Resize(UBound(Brr), C(2))
     .Value = Brr
     '¡ô¥OÀx¦s®æ­È¥HBrr°}¦C±a¤J
     .Borders.LineStyle = 1
     '¡ô¥OÀx¦s®æ®Ø½u¬O²Ó¹ê½u
     .ColumnWidth = 4
     '¡ô¥OÀx¦s®æÄæ¼e¬O 4
     .Font.Size = 14
     '¡ô¥OÀx¦s®æ¦r¤j¤p¬O 4
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

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


Option Explicit
Sub TEST()
Dim Brr, Crr, Y, R%, i&, j%, T%
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Range([H1], Cells(1, Columns.Count)).EntireColumn.Delete
'¡ô¥OHÄæ¨ì³Ì«áÄæ§R°£
Brr = Range([C3], [A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥H[A3]¨ìCÄæ³Ì«á¤@­Ó¦³¤º®eÀx¦s®æ­È±a¤J
ReDim Crr(1 To 8, 1 To 200)
'¡ô¥OCrrÅܼƬO ¤GºûªÅ°}¦C,Áa¦V½d³ò1~8,¾î¦V½d³ò1~200
Y("¤W°Ï") = 0: Y("¤U°Ï") = 4
'¡ô¥O"¤W°Ï"¦r¦ê·íkey,item¬O 0;¥O"¤U°Ï"¦r¦ê·íkey,item¬O 4:¯Ç¤JY¦r¨å¸Ì
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é
   T = Brr(i, 1)
   '¡ô¥OTÅܼƬO²Ä1ÄæBrr°}¦C­È
   R = IIf(T > 6, Y("¤U°Ï"), Y("¤W°Ï")): Y(R) = Y(R) + 1
   '¡ô¥ORÅܼƬOIIf()¦^¶Ç­È,¦pªGTÅÜ¼Æ ¤j©ó6,¦^¶Ç4,§_«h0
   '¡ô¥O¦bY¦r¨å¸Ì0©Î4ªºkey,¨äitem­È²Ö¥[1(¬ö¿ýÄæ³Ì«á¯Á¤Þ¸¹)

   For j = 1 To 3
   '¡ô³]¶¶°j°é
        Crr(R + j, Y(R)) = Brr(i, j)
        '¡ô¥OBrr°}¦C­È¼g¤JCrr°}¦C«ü©w¦ì¸m¸Ì
   Next j
   If Y(R) > Y("Äæ¼Æ") Then Y("Äæ¼Æ") = Y(R)
   '¡ô¦pªG¤W¤U°ÏªºÄ渹¤j©ó ¥H"Äæ¼Æ"¬dY¦r¨åªºitem­È,
    '´N¥OY¦r¨åªº"Äæ¼Æ"key¹ïÀ³ªºitem­È¬O ¤W¤U°ÏªºÄ渹
    'Y("Äæ¼Æ")¬O¬°¤F­pºâ°}¦C³Ì¤j»Ý¨DÄæ¼Æ

Next
With [h2].Resize(UBound(Crr), Y("Äæ¼Æ"))
     .Value = Crr
     '¡ô¥OÀx¦s®æ­È¥HCrr°}¦C±a¤J
     .Borders.LineStyle = 1
     '¡ô¥OÀx¦s®æ®Ø½u¬O²Ó¹ê½u
     .ColumnWidth = 4
     '¡ô¥OÀx¦s®æÄæ¼e¬O 4
     .Font.Size = 14
     '¡ô¥OÀx¦s®æ¦r¤j¤p¬O 4
End With
Set Y = Nothing: Erase Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¤@­Ó¤H¤£©È¿ù¡A´N©È¤£§ï¹L¡A§ï¹L¨Ã¤£Ãø¡C
ªð¦^¦Cªí ¤W¤@¥DÃD