| |
列はA〜C、D〜F列として書きました。修正してください。
テストしていませんので、動かなければ手入れをしてください。
Dictionaryが不明なら、ネットで検索して学習してください。
Sub Sample()
Dim dic1 As Object, dic2 As Object
Dim s1 As String, s2 As String, s As String
Dim k As Long
Dim v As String
Set dic1 = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
For k = 2 To Range("A1").End(xlDown).Row
s1 = Cells(k, 1).Value & vbTab & Cells(k, 2).Value
s2 = Cells(k, 3).Value
s = s1 & vbTab & s2
dic1(s) = Empty
dic2(s1) = s2
Next
For k = 2 To Range("D1").End(xlDown).Row
s1 = Cells(k, 4).Value & vbTab & Cells(k, 5).Value
s2 = Cells(k, 6).Value
s = s1 & vbTab & s2
If Not (IsEmpty(s2) Or s2 = "") Then
If dic1.Exists(s) Then
Cells(k, 6).Font.ColorIndex = 0 '黒
Else
If dic2.Exists(s1) Then
v = dic2(s1)
If v >= Cells(k, 6).Value Then
Cells(k, 6).Font.ColorIndex = 3 '赤
Else
Cells(k, 6).Font.ColorIndex = 41 '青
End If
End If
End If
Else
If dic2.Exists(s1) Then
Cells(k, 6).Value = dic2(s1)
End If
End If
Next
End Sub
|
|
不明
- 11/1/28(金) 8:38 -
