| |
▼やす さん：
こんにちは！
>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 ○
これしか情報がないと、下６つに重複されているのがなぞですが･･･
やすさんのコードを参照し、いじってみました。
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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
