- ©«¤l
- 4901
- ¥DÃD
- 44
- ºëµØ
- 24
- ¿n¤À
- 4916
- ÂI¦W
- 239
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Office 20xx
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-4-30
- ³Ì«áµn¿ý
- 2024-11-4
|
¦^´_ 16# b9208 - Sub ex()
- Dim A As Range, C As Range, Rng As Range, MyRng As Range, m$
- Set d = CreateObject("Scripting.Dictionary")
- Set d1 = CreateObject("Scripting.Dictionary")
- With Sheets("³æ¦ì")
- Set Rng = .[D3:G3]
- With Sheets("¸ê®Æ")
- For Each A In .Range(.[F6], .[F6].End(xlDown))
- m = A.Offset(, -3) & A & A.Offset(, 2)
- If d(m) <= A.Offset(, 5).Value Then d(m) = A.Offset(, 5).Value '°O¦í³Ì¤jÈ
- d1(m) = d1(m) + 1 'pºâÓ¼Æ
- Set C = Rng.Find(A, lookat:=xlWhole)
- If Not C Is Nothing Then
- If MyRng Is Nothing Then Set MyRng = A.Offset(, -5).Resize(, 13) Else Set MyRng = Union(MyRng, A.Offset(, -5).Resize(, 13))
- End If
- Next
- End With
- .Range("A19").CurrentRegion.Interior.ColorIndex = 0
- If Not MyRng Is Nothing Then MyRng.Copy .[A20] Else MsgBox "µL²Å¦X¸ê®Æ": Exit Sub
- .Range("A19").CurrentRegion.Sort key1:=.[K19], Header:=xlYes
- .Range("A19").CurrentRegion.Sort key1:=.[F19], key2:=.[C19], key3:=.[H19], Header:=xlYes
- For Each A In .Range(.[F20], .[F20].End(xlDown))
- m = A.Offset(, -3) & A & A.Offset(, 2)
- If d1(m) > 1 Then A.Offset(, -5).Resize(, 13).Interior.ColorIndex = 6 '¦³«½Æ
- If A.Offset(, 5) <> d(m) Then A.Offset(, 5) = 0 '¤£µ¥©ó³Ì¤jÈ´NÂk¹s
- Next
- End With
- End Sub
½Æ»s¥N½X |
|