| 
    
     |  | ▼やす さん: こんにちは!
 
 >B列  C列    D列     E列   F列   G列
 >    会議室名 使用年月日  AM    PM   全日
 >    第1    2008/1/1    ○
 >    第1    2008/1/1        ○
 >重複  第1    2008/1/2    ○
 >重複  第1    2008/1/2        ○
 >重複  第1    2008/1/2             ○
 >重複  第1    2008/1/3    ○
 >重複  第1    2008/1/3    ○
 >重複  第1    2008/1/3             ○
 
 これしか情報がないと、下6つに重複されているのがなぞですが・・・
 
 
 やすさんのコードを参照し、いじってみました。
 Ifばかりでややこしいですが、こんな感じでいかがでしょう?
 
 Sub test0()
 
 Dim dc As Object
 Dim MaxRow As Long
 Dim buf1 As String
 Dim buf2 As String
 Dim buf3 As String
 Dim buf4 As String
 Dim i As Long
 Dim myKey As String, myAM As String, myPM As String, myAL As String
 
 Set dc = CreateObject("Scripting.Dictionary")
 
 MaxRow = Cells(Rows.Count, 3).End(xlUp).Row
 
 For i = 6 To MaxRow
 
 myAM = Range("E" & i).Value
 myPM = Range("F" & i).Value
 myAL = Range("G" & i).Value
 
 If myAM = "" Then
 myAM = "-"
 End If
 
 If myPM = "" Then
 myPM = "-"
 End If
 
 If myAL = "" Then
 myAL = "-"
 End If
 
 buf1 = Range("C" & i).Value & Range("D" & i).Value
 buf2 = myAM & myPM & myAL
 
 If Not dc.Exists(buf1) Then
 If myAL = "○" Then 'myALに○があれば、後の同じ日付をすべて重複にするようにする
 buf4 = "○--" & vbTab & "-○-"
 dc.Add buf1, buf4
 Else
 dc.Add buf1, buf2
 End If
 Else
 If myAL = "○" Then 'すでに同じ日付でAMかPMで使用されていたら重複にする
 Range("B" & i).Value = "重複"
 Else
 If InStr(dc.Item(buf1), buf2) > 0 Then
 Range("B" & i).Value = "重複"
 Else
 buf3 = dc.Item(buf1) & vbTab & buf2
 dc.Item(buf1) = buf3
 End If
 End If
 End If
 
 Next
 
 End Sub
 
 
 |  |