Hsieh

¦^´_ 1# b9208

1. Sub nn()
   
2. Dim A As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set dd = CreateObject("Scripting.Dictionary")
   
5. Set dd1 = CreateObject("Scripting.Dictionary")
   
6. Set d1 = CreateObject("Scripting.Dictionary")
   
7. With Sheet1
   
8. For Each A In .UsedRange.Columns("F").Cells
   
9. If IsDate(A) Then myday = A
   
10. If Not IsEmpty(myday) And A <> "" Then
    
11. d(myday & A.Offset(, -1)) = Join(Application.Transpose(Application.Transpose(A.Resize(, 10))), Chr(10))
    
12. dd(myday & A.Offset(, -1)) = A.Address
    
13. A.EntireRow.Interior.ColorIndex = -4142
    
14. End If
    
15. Next
    
16. End With
    
17. With Sheet2
    
18. For Each A In .UsedRange.Columns("F").Cells
    
19. If IsDate(A) Then myday = A
    
20. If Not IsEmpty(myday) And A <> "" Then
    
21. d1(myday & A.Offset(, -1)) = Join(Application.Transpose(Application.Transpose(A.Resize(, 10))), Chr(10))
    
22. dd1(myday & A.Offset(, -1)) = A.Address
    
23. A.EntireRow.Interior.ColorIndex = -4142
    
24. End If
    
25. Next
    
26. End With
    
27. For Each ky In d.keys
    
28.    If d1.exists(ky) = True Then
    
29.       If d(ky) <> d1(ky) Then
    
30.          ar = Split(d(ky), Chr(10))
    
31.          ar1 = Split(d1(ky), Chr(10))
    
32.          For i = 0 To 9
    
33.            If ar(i) <> ar1(i) Then
    
34.            Sheet1.Range(dd(ky)).Offset(, i).Interior.ColorIndex = 6
    
35.            Sheet2.Range(dd(ky)).Offset(, i).Interior.ColorIndex = 6
    
36.            End If
    
37.          Next
    
38.       End If
    
39.       Else
    
40.       Sheet1.Range(dd(ky)).EntireRow.Interior.ColorIndex = 35
    
41.     End If
    
42. Next
    
43. For Each ky In d1.keys
    
44.    If d.exists(ky) = False Then Sheet2.Range(dd1(ky)).EntireRow.Interior.ColorIndex = 35
    
45. Next
    
46. End Sub

½Æ»s¥N½X