- ©«¤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
|
ÁÂÁ½׾Â,ÁÂÁ¦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¬°¤Fpºâ°}¦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 |
|