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

[µo°Ý] §ä¨ì¨Ã§R°£Á`­p=0ªºÄæ¦ì

[µo°Ý] §ä¨ì¨Ã§R°£Á`­p=0ªºÄæ¦ì

¦U¦ì¥ý¶i¡A½Ð°ÝÄæ¦C¼Æ¤£¤@©w¡A­n§ä¨ì©³³¡¥[Á`µ¥©ó0ªºÄæ¨Ã±N¸ÓÄæ§R°£

§R°£«á~

Excel-§R°£Á`­p0.rar (15.11 KB)
Adam

¸Õ¥X¨Ó¤F
Sub ¥¨¶°1()
'
' ¥¨¶°1 ¥¨¶°
'   
    Range("A1").Select
    row1 = ActiveCell.End(xlDown).Row
   
    Dim i&, xU As Range
    For i = 9 To Cells(row1, Columns.Count).End(xlToLeft).Column
    If Cells(row1, i) = 0 Then
       If xU Is Nothing Then Set xU = Cells(row1, i) Else Set xU = Union(xU, Cells(row1, i))
    End If
  Next i
  If Not xU Is Nothing Then xU.EntireColumn.Delete
   
End Sub
Adam

TOP

¦^´_ 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
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

¦^´_ 3# Andy2483

·PÁ¦^´_¡A°õ¦æ«á¥i¥¿½T§ä¥XÁ`­p¬°0ªºÄæ¦ì
Adam

TOP

¦^´_ 4# hcm19522


    ·PÁÂhcm19522¤j´£¨Ñªº°Ñ¦Ò
Adam

TOP

        ÀR«ä¦Û¦b : ­n¥Î¤ß¡A¤£­n¾Þ¤ß¡B·Ð¤ß¡C
ªð¦^¦Cªí ¤W¤@¥DÃD