- ©«¤l
- 2831
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2887
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2024-11-4
|
¦^´_ 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 |
|