Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


22722 / 76738 ←次へ | 前へ→

【59393】Re:重複の行を調べたい
発言  にぃ  - 08/12/9(火) 17:53 -

引用なし
パスワード
   ▼やす さん:
こんにちは!

>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

0 hits

【59384】重複の行を調べたい やす 08/12/9(火) 13:19 質問
【59393】Re:重複の行を調べたい にぃ 08/12/9(火) 17:53 発言
【59397】Re:重複の行を調べたい やす 08/12/9(火) 19:35 お礼

22722 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free