­ã´£³¡ª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

­ã´£³¡ªL

¦^´_ 7# starry1314


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

­ã´£³¡ª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

­ã´£³¡ªL

¦^´_ 13# starry1314


Set xArea = Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp)(1, 8))¡@¡@

¬õ¦â³¡¥÷½Ð§R±¼¡]¤@®Éµ§»~¡D¨Sµo²{¡^¡I
¨ú¤@­ÓÄæ¦ì§Y¥i¡A¦h¤F¬õ¦â³¡¥÷¡AxArea´NÅܦ¨¢·­ÓÄæ°Ï¡ã¡ã

¨ä¥¦¤j­P¢÷¢ó¡A´N¥u¬Ý¸ê®Æ¬O§_¦³©T©w¬[ºc¡A¤£µM¤]¬OÃø¥H¥¿½T°õ¦æµ{¦¡ªº¡I


¤U¤@¦æ¥i¦Û°Ê°»´ú¡eÄæ¦ì¡f¼Æ¡G
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column Step 9

­ã´£³¡ªL

¦^´_ 15# starry1314


¶¡¹j¢³¸õ¤T¦¸¡A¢°¡Ð¢´¡Ð¢¸¡A¦A¸õ¤@¦¸´N¢°¢²¡A©Ò¥H 1 To 9 ©Î 1 To 12 ¦P¼Ë¡ã¡ã

­ã´£³¡ªL

For Each xR In xArea
¡@¡@If xR(1, 10) = "A" Then
¡@¡@¡@T = xR(1, 5) & xR(1, 6)
¡@¡@¡@xD(T) = xD(T) + 1
¡@¡@End If
Next

«D"A"®É¡A¤£­n³B²z§Y¥i¡I