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

[µo°Ý] ½Ð°Ý¦p¦ó¥i²Î­p¥X²{¦¸¼Æ¨Ã¥B¥]§t¦h±ø¥óªº¸ê®Æ§R°£©O?

[µo°Ý] ½Ð°Ý¦p¦ó¥i²Î­p¥X²{¦¸¼Æ¨Ã¥B¥]§t¦h±ø¥óªº¸ê®Æ§R°£©O?

¦p¦ó³]©w¯à±N¥ª¤è­ì©l¸ê®Æ
1.¦PÃþ§O¤º¦P«~¦W¬Û¦PªÌ¥B¼Æ¶q¤j©ó20ªº
.¨Ã¥B³ÆµùÄæ¥u¦³¡i.¡jªº¸ê®Æ¦C§R°£©O?

¥D­n¥d¦b¤£ª¾¸Ó¦p¦ó²Î­p¦¹¥X²{¦¸¼Æ¤j©ó20ªº¶µ¥Ø°µ§R°£

¦h±ø¥ó§PÂ_§R°£.zip (12.72 KB)

http://blog.xuite.net/hcm19522/twblog/348638247

TOP

¥ý±N¼Ï¯Ã¤ÀªRªí¤º®e¶K¦Ü¥t¤@¤u§@ªí!

Sub TEST()
Dim xArea As Range, xR As Range, xU As Range, xD, T$
Set xD = CreateObject("Scripting.Dictionary")
Set xArea = Range([B2], [B65536].End(xlUp))
'¥H¢Ð¢ÑÄæ­È¬°KEY¯Ç¤J¦r¨åÀɨò֭p¦¸¼Æ¡@
For Each xR In xArea
¡@T = xR & xR(1, 2):  xD(T) = xD(T) + 1
Next
'Àˬd²Å¦X§R°£±ø¥óªÌ¡A¯Ç¤J xU Àx¦s®æÁp¶°¡@
Set xU = xArea(xArea.Count + 1)
For Each xR In xArea
¡@T = xR & xR(1, 2)
¡@If xD(T) >= 20 And xR(1, 3) = "." Then Set xU = Union(xU, xR)
Next
'§R°£¡@
xU.EntireRow.Delete
End Sub

TOP

¯u¬O¨ü¥Î¡A·PÁ¤À¨É!!

TOP

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


    ·PÁÂ~¯u¬O¦n¥Î¡I¥i¥Î¦b«Ü¦h¦a¤è

TOP

¦^´_ 2# hcm19522


    ÁÂÁ¡㴣¨Ñ¨ç¼Æ¥Îªk

TOP

¦^´_ 3# ­ã´£³¡ªL
ª©¤j¡ã¤£¦n·N«ä¡@¹J¨ì­Ó°ÝÃD¡@
¦A§R°£¸ê®Æ®É¥i³]©w½d³ò¶Ü¡H¡@¦]¦P¤@¬¡­¶¤º¦³¤T±iªí®æ¡A¥Ø«e¦¹¥N½X·|§R°£¾ã¦C¾É­P¥t¥~¨â±i¸ê®Æ¤]¤@¨Ö§R°£¤F

¦p¹³¤U¦C³oºØ¡@¥u§R°£¿z¿ï½d³ò¤º¸ê®Æ
  1. With Sheets("¼Æ¾Ú(¦­À\)")
  2.         .Select
  3.         .Range("$A$1:AA5000").AutoFilter Field:=6, Criteria1:=Array( _
  4.         "¬õ¯ù", "¥¤¯ù", "0"), Operator:=xlFilterValues
  5.         
  6.         With .AutoFilter.Range
  7.             .Offset(1).Resize(.Rows.Count).SpecialCells(xlCellTypeVisible).ClearContents
  8.             .AutoFilter
  9.         End With
  10.         
  11.     End With
½Æ»s¥N½X

TOP

¦^´_ 7# starry1314


½Ð¤W¶ÇÀÉ®×, ¨Ã¼ÒÀÀ»Ý¨Dµ²ªG~~

TOP

¦h±ø¥ó§PÂ_§R°£.rar (16.02 KB) ¦^´_ 8# ­ã´£³¡ªL

µ²ªG¬O¸ò¥H¤U¥N½X¤@¼Ëªº,¥u¬O»¡¤£­n§R°£¾ã¦C ¥u§R°£«ü©w½d³ò¤ºªº¸ê®Æ
  1. Sub TEST()
  2. Dim xArea As Range, xR As Range, xU As Range, xD, T$
  3. Set xD = CreateObject("Scripting.Dictionary")
  4. Set xArea = Range([B2], [B65536].End(xlUp))
  5. '¥H¢Ð¢ÑÄæ­È¬°KEY¯Ç¤J¦r¨åÀɨò֭p¦¸¼Æ¡@
  6. For Each xR In xArea
  7. ¡@T = xR & xR(1, 2):  xD(T) = xD(T) + 1
  8. Next
  9. 'Àˬd²Å¦X§R°£±ø¥óªÌ¡A¯Ç¤J xU Àx¦s®æÁp¶°¡@
  10. Set xU = xArea(xArea.Count + 1)
  11. For Each xR In xArea
  12. ¡@T = xR & xR(1, 2)
  13. ¡@If xD(T) >= 20 And xR(1, 3) = "." Then Set xU = Union(xU, xR)
  14. Next
  15. '§R°£¡@
  16. xU.EntireRow.Delete
  17. End Sub
½Æ»s¥N½X

TOP

¦^´_ 9# starry1314


Sub TEST()
Dim xArea As Range, xR As Range, xU As Range, xD, T$, i&
For i = 1 To 9 Step 4
¡@¡@Set xD = CreateObject("Scripting.Dictionary")
¡@¡@Set xArea = Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp)(1, 4))
¡@¡@For Each xR In xArea
¡@¡@¡@¡@T = xR(1, 2) & xR(1, 3): xD(T) = xD(T) + 1
¡@¡@Next
¡@
¡@¡@Set xU = Cells(xArea.Rows.Count + 2, 1)
¡@¡@For Each xR In xArea
¡@¡@¡@¡@T = xR(1, 2) & xR(1, 3)
¡@¡@¡@¡@If xD(T) >= 20 And xR(1, 4) = "." Then Set xU = Union(xU, xR.Resize(1, 4))
¡@¡@Next
¡@
¡@¡@If xU.Count > 1 Then xU.Delete Shift:=xlUp
Next i
End Sub

TOP

        ÀR«ä¦Û¦b : ­n§åµû§O¤H®É¡A¥ý·Q·Q¦Û¤v¬O§_§¹¬üµL¯Ê¡C
ªð¦^¦Cªí ¤W¤@¥DÃD