- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¦^´_ 1# §ÚªÎ¤H
ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¨ì«Ü¦hª¾ÃÑ»P¸gÅç,¸Ñ¨M¤è®×¦p¤U,
½Ð«e½ú°Ñ¦Ò,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e: 5~7 ªÅ6
°õ¦æµ²ªG:
§R°£2.3¦C: «e«á³£¦³ªÅ
°õ¦æµ²ªG:
Option Explicit
Sub TEST_1()
Dim Brr, Y, i&, X&, xR As Range
'¡ô«Å§iÅܼÆ:(Brr,Y)¬O³q¥Î«¬ÅܼÆ,(i,X)¬Oªø¾ã¼ÆÅܼÆ,
'xR¬OÀx¦s®æÅܼÆ
Set xR = Range([B1], Cells(Rows.Count, "A").End(3))
'¡ô¥OxR³oÀx¦s®æÅܼƬO [B1]¨ìAÄæ³Ì«á¦³¤º®eÀx¦s®æ,
'xRÅܼƬO¦¹½d³òªºÀx¦s®æ(ª«¥ó)
Brr = xR
'¡ô¥OBrr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,
'¥HxRÀx¦s®æȱa¤JBrr°}¦C¤¤
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY³o³q¥Î«¬ÅܼƬO ¦r¨å
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q2¨ì Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
Y(Brr(i, 2)) = "": Brr(i, 1) = i - 1
'¡ô¥Oi°j°é¦C²Ä2ÄæBrr°}¦CÈ·íkey,item¬OªÅ¦r¤¸,¯Ç¤JY¦r¨å¸Ì,
'¥Oi°j°é¦C²Ä1ÄæBrr°}¦CȬO iÅܼÆ-1
Next
For X = 1 To Y.Count
'¡ô³]¶¶°j°é!i±q1¨ì Y¦r¨åkey¼Æ¶q¼Æ
For i = 2 To UBound(Brr): Y(Brr(i, 2)) = "": Next
'¡ô³]¶¶°j°é!i±q2¨ì Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹,
'¥Oi°j°é¦C²Ä2ÄæBrr°}¦CÈ·íkey,item¬OªÅ¦r¤¸,¯Ç¤JY¦r¨å¸Ì
If Y.Exists(X) = Empty Then
'¡ô¦pªGY¦r¨å¸Ì¨S¦³XÅܼƳokey?
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q2¨ì Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
If Brr(i, 2) > X Then Brr(i, 2) = Brr(i, 2) - 1
'¡ô¦pªGi°j°é¦C²Ä2ÄæBrr°}¦CȤj©ó XÅܼÆ!
'´N¥Oi°j°é¦C²Ä2ÄæBrr°}¦CÈ -1
Next
X = X - 1
'¡ô¥OXÅÜ¼Æ -1
End If
Y.RemoveAll
'¡ô¥OY¦r¨å²MªÅ
Next
xR.Offset(, 3) = Brr
'¡ô¥OxRÅܼƦV¥k°¾²¾3Ä檺½d³òÀx¦s®æÈ¥HBrr°}¦Cȱa¤J
Set Y = Nothing: Erase Brr: Set xR = Nothing
'¡ô¥OÄÀ©ñÅܼÆ
End Sub |
|