- ©«¤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# adam2010
ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò,ÁÂÁ½׾Â
«á¾ÇÂǦ¹©«½m²ß°}¦C»PÀx¦s®æ¦ì§}¤§¶¡ªº¹ï·Ó,½m²ß¨ì«Ü¦h¤ß±o,
«á¾Ç½m²ßªº¸Ñ¨M¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò
°õ¦æ«e:
°õ¦æµ²ªG:
Option Explicit
Sub TEST()
Dim Brr, Ra, Rs, Rn, j%, xU As Range, xA As Range
'¡ô«Å§iÅܼÆ:(Brr,Ra,Rs,Rn)¬O³q¥Î«¬ÅܼÆ,j¬Oµu¾ã¼ÆÅܼÆ,(xU,xA)¬OÀx¦s®æÅܼÆ
Set xA = Sheets("¤u§@ªí1").UsedRange
'¡ô¥OxA³oÀx¦s®æÅܼƬO "¤u§@ªí1" ¤u§@ªíªº¦³¨Ï¥ÎÀx¦s®æ
For Each Ra In xA.SpecialCells(2)
'¡ô³]³v¶µ°j°é!¥ORa³o³q¥Î«¬ÅܼƬO xAÀx¦s®æ¶°¸Ìªº«DªÅ®æÀx¦s®æ¤§¤@
Rn = IIf(Ra = "Á`p" And Rn = "" And Rs <> "", Ra.Address, Rn)
'¡ô¥ORn³o³q¥Î«¬ÅܼƬOIIf()¦^¶ÇÈ,
'IIf():¦pªGRaÅܼƬO "Á`p"¦r¦ê,¦Ó¥BRn¬OªÅ¦r¤¸,¨Ã¥BRsÅܼƤ£¬OªÅ¦r¤¸?
'´N¥ORnÅܼƬO RaÅܼƪºÀx¦s®æ¦ì§},§_«h¥ORnÅܼƨ̵M¬O RnÅܼÆ
Rs = IIf(Ra = "Á`p" And Rs = "", Ra.Address, Rs)
'¡ô¥ORs³o³q¥Î«¬ÅܼƬOIIf()¦^¶ÇÈ,
'IIf():¦pªGRaÅܼƬO "Á`p"¦r¦ê,¦Ó¥BRs¬OªÅ¦r¤¸,
'´N¥ORsÅܼƬO RaÅܼƪºÀx¦s®æ¦ì§},§_«h¥ORsÅܼƨ̵M¬O RsÅܼÆ
Next
If Rs = Empty Or Rn = Empty Then Exit Sub
'¡ô¦pªGRsÅܼƬOªì©lÈ ©Î ¦pªGRnÅܼƬOªì©lÈ!´Nµ²§ôµ{¦¡°õ¦æ
Set xA = Range(Rs, Rn)
'¡ô¥OxA³oÀx¦s®æÅܼƬO ¨âÓ(Á`p)Àx¦s®æÂX®i½d³òªºÀx¦s®æ
Brr = xA
'¡ô¥OBrr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥HxAÅܼÆȱa¤J
Set xU = Cells(1, Columns.Count)
'¡ô¥OxU³oÀx¦s®æÅܼƬO ²Ä1¦C³Ì«á¤@ÄæÀx¦s®æ
For j = 1 To UBound(Brr, 2)
'¡ô³]¶¶°j°é!j±q1¨ì Brr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹
If IsDate(Brr(1, j)) And Brr(UBound(Brr), j) = 0 Then
'¡ô¦pªG²Ä1¦CjÅܼÆÄæBrr°}¦CȬO¤é´Á,¦Ó¥B³Ì«á¦CjÅܼÆÄæBrr°}¦CȬO 0
Set xU = Union(xU, xA(j))
'¡ô¥OxAÅܼÆ(Àx¦s®æ)¸Ìªº ²ÄjÅܼÆÓÀx¦s®æ,¯Ç¤JxUÀx¦s®æ¶°¸Ì
End If
Next
Application.Goto xU.EntireColumn
'¡ô¥OÀx¦s®æ´å¼Ð¨ì xUÅܼƩҦbªºÄæ¦ì
Set xA = Nothing: Set xU = Nothing: Set Ra = Nothing: Erase Brr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub |
|