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

starry1314

¦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°£

¤U¸ü (36.58 KB)

2015-10-10 13:38

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

¤U¸ü¦¸¼Æ: 17

2015-10-10 13:39

hcm19522

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

­ã´£³¡ªL

¥ý±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

kingvincent

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

starry1314

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


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

starry1314

¦^´_ 2# hcm19522


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

starry1314

¦^´_ 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

­ã´£³¡ªL

¦^´_ 7# starry1314


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

starry1314

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

¤U¸ü¦¸¼Æ: 6

2015-11-27 14:40

¦^´_ 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

¤U¸ü (222.46 KB)

2015-11-27 14:42

­ã´£³¡ªL

¦^´_ 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