¸­°ê¬w

1. Sub test()
   
2. Dim d,d1,m%,n%,i%,j%,Rng, found
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d1 = CreateObject("scripting.dictionary")
   
5. Range("c3:f" & Cells(Rows.Count, 3).End(xlUp).Row).Interior.Color = xlNone
   
6. For i = 3 To Range("c3").End(xlDown).Row
   
7.     d(Cells(i, 3).Value) = ""
   
8. Next i
   
9. k = d.keys
   
10. For i = 0 To UBound(k)
    
11.     For j = 3 + n To Range("c3").End(xlDown).Row
    
12.         If k(i) = Cells(j, 3) Then
    
13.             m = m + 1
    
14.             n = n + 1
    
15.         Else
    
16.             Set Rng = Cells(j - m, 3).Resize(m, 4)
    
17.             For Each Cell In Rng.Range(Cells(1, 4), Cells(Rng.Rows.Count, 4))
    
18.                 If CDate(Split(Cell.Value, " ")(0)) = Date Then
    
19.                     found = True
    
20.                     d1(Split(Cell.Value, " ")(0)) = ""
    
21.                 Else
    
22.                     d1(Split(Cell.Value, " ")(0)) = ""
    
23.                 End If
    
24.             Next Cell
    
25.                 k1 = d1.keys
    
26.             Select Case d1.Count
    
27.                 Case 1
    
28.                     If CDate(k1(0)) = Date Then
    
29.                     Rng.Interior.Color = 255
    
30.                     End If
    
31.                 Case 2
    
32.                     If found = True Then
    
33.                         For ii = 1 To Rng.Rows.Count
    
34.                             If CDate(Split(Rng.Cells(ii, 4), " ")(0)) <> Date Then
    
35.                                 Rng.Cells(ii, 1).Resize(1, 4).Interior.Color = 16711935
    
36.                             End If
    
37.                         Next ii
    
38.                     End If
    
39.                 Case Else
    
40.                     If found = True Then
    
41.                         For ii = 1 To Rng.Rows.Count
    
42.                             If CDate(Split(Rng.Cells(ii, 4), " ")(0)) = Date Then
    
43.                                 Rng.Cells(ii, 1).Resize(1, 4).Interior.Color = 255
    
44.                             End If
    
45.                         Next ii
    
46.                     End If
    
47.             End Select
    
48.             m = 0
    
49.             found = False
    
50.             d1.RemoveAll
    
51.             Exit For
    
52.         End If
    
53.     Next j
    
54. Next i
    
55. If Range("a2") <> "" Then
    
56. Set Rng = Range("c3:c" & Cells(Rows.Count, 3).End(xlUp).Row)
    
57.     For i = 1 To Rng.Rows.Count
    
58.        If Rng.Cells(i) = Range("a2") Then
    
59.        Rng.Resize(i, 4).Interior.Color = xlNone
    
60.        End If
    
61.     Next i
    
62. End If
    
63. End Sub

½Æ»s¥N½X

¦^´_ 1# RCRG

¸­°ê¬w

´ú¸Õ¸ê®Æ&#153219;¨S¦³·í¤Ñ¤é´Á¡A©Ò¥H¤£·|¶ñ¥RÃC¦â
½Ð¦Û¦æ¿é¤J·í¤Ñ¤é´Á¡A¦A°õ¦æµ{¦¡

¸­°ê¬w

¦^´_ 5# RCRG
§Ú§¹¥þ¨S¦³¦Ò¼{¨ìC1Àx¦s®æ,C1¦³¥ô¦óÅܰʬO¤£·|¼vÅT¨ìµ{¦¡ªº
¦³­n°µ­×§ïªº³¡¤À,½ÐÀHªþ¥ó¤W¼ÒÀÀ§A­nªºµ²ªG,¥ú¦r­±¤W»¡©ú,¦³
®É¤£¤@©w¨C­Ó¤H³£¯à©ú¥Õ§A¯u¥¿ªº»Ý¨D,©Î¦³®É§O¤H·|»~¸Ñ§Aªº恴«ä

¸­°ê¬w

¦^´_ 9# RCRG
¬Ý¬Ý³o¼Ë¥i¥H¶Ü

1. Sub ex()
   
2. Dim d, d1, rng() As Range, arr, i%, j%, rng1 As Range
   
3. For i = 3 To Cells(Rows.Count, 3).End(xlUp).Row
   
4. If Right(Cells(i, 3), 1) = ChrW(160) Then
   
5. Cells(i, 3).Replace ChrW(160), ""
   
6. End If
   
7. Next i
   
8. Set d = CreateObject("scripting.dictionary")
   
9. Set d1 = CreateObject("scripting.dictionary")
   
10. With Sheets("´ú¸Õ­¶")
    
11. Set rng1 = .Range("a2:a" & .Cells(Rows.Count, 1).End(xlUp).Row)
    
12. arr = .Range("c3:f" & .Cells(Rows.Count, 3).End(xlUp).Row)
    
13. .Range("c3:f" & .Cells(Rows.Count, 3).End(xlUp).Row).Interior.Color = xlNone
    
14.     For i = 1 To UBound(arr)
    
15.         d(arr(i, 1)) = d(arr(i, 1)) + 1
    
16.     Next i
    
17.     ReDim rng(1 To d.Count)
    
18.     t = d.items
    
19.     For i = 1 To d.Count
    
20.         k = k + t(i - 1)
    
21.         Set rng(i) = .Range(.Cells(2 + k - t(i - 1) + 1, 3), .Cells(2 + k, 6))
    
22.         If WorksheetFunction.CountIf(rng(i), ">" & .Range("c1")) = rng(i).Rows.Count And _
    
23.             WorksheetFunction.CountIf(rng1, rng(i).Cells(1, 1)) = 0 Then
    
24.             rng(i).Interior.Color = 255
    
25.         ElseIf WorksheetFunction.CountIf(rng(i), ">" & .Range("c1")) < rng(i).Rows.Count And _
    
26.                WorksheetFunction.CountIf(rng(i), ">" & .Range("c1")) <> 0 Then
    
27.             For j = 1 To rng(i).Rows.Count
    
28.                 If rng(i).Cells(j, 4) < Range("c1") Then
    
29.                     spr = Split(rng(i).Cells(j, 4), " ")(0)
    
30.                     d1(spr) = d1(spr) + 1
    
31.                 End If
    
32.             Next j
    
33.              k1 = d1.keys
    
34.              If d1.Count = 1 Then
    
35.                For j = 1 To rng(i).Rows.Count
    
36.                  If rng(i).Cells(j, 4) < .Range("c1") And WorksheetFunction.CountIf(rng1, rng(i).Cells(1, 1)) = 0 Then
    
37.                     rng(i).Rows(j).Interior.Color = 16711935
    
38.                  End If
    
39.                Next j
    
40.              End If
    
41.           End If
    
42.         d1.RemoveAll
    
43.     Next i
    
44. End With
    
45. End Sub

½Æ»s¥N½X

¸­°ê¬w

¦^´_ 14# RCRG

Selection.FormulaR1C1 = ""³o¦æ¤U­±¦A¥[
Selection.interior.color = xlnone