[[20110406004708]]　『２シート間での重複チェック』（目から鱗）　ページの最後に飛ぶ

『２シート間での重複チェック』（目から鱗）

WindowsXP　Excel2003

VBAは初心者です。独学で勉強している最中になります。

保存する前に、２シート間での重複チェックを考えております。

シート１にて入力した際　
A列とB列同じ文字列がシート１、シート２で重複していないかチェック

シート２にて入力した際
A列とB列同じ文字列がシート２、シート１で重複していないかチェック

 シート１
 　　A列　　B列　　
 1行 A店　 リンゴ
 2行 B店   レモン
 3行 B店　 リンゴ
 4行 A店　 リンゴ　1行目と重複のでNG

 シート２
 　　A列　　B列　　
 1行 C店　 リンゴ
 2行 D店   レモン
 3行 E店　 リンゴ
 4行 B店　 レモン　2行目と重複のでNG

下記はシートモジュールです。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
保存する前のイベント

If Target.Count > 1 Then Exit Sub

If WorksheetFunction.CountIf(Worksheets("sheet1").UsedRange, Target.Value) > 1 Then MsgBox "sheet1に重複あり"

使用範囲で指定しているので、A列、B列を指定できませんか？

 尚且つ、A列とB列が同じと判断して重複チェックできないか悩んでいます。
CountIfではなく、sumproductを使用した方がいいのでしょうか

If WorksheetFunction.CountIf(Worksheets("sheet2").UsedRange, Target.Value) > 0 Then MsgBox "sheet2に重複あり"

End Sub

長くなってしまいましたが、返答をお願いいたします。

 >If Target.Count > 1 Then Exit Sub 
 このTarget　って、どこからでてきたんですか？

 まあでも、やりたいことは何となくですが理解できました。

 一応、保存時にシート1、シート2のデータに重複データがあったら、
 エラーメッセージを表示し、保存しないという仕様にしました。
 問題は、重複チェックでしょうから、問題があったら変更してください。

 まず、Excelでデータベースを作成するなら、
 1行目には、項目名にしてください。
 その方がVBAで操作する上でも便利ですし、Excelの機能も使いやすいですから・・・。

 よって、提示されたデータは、

 シート１
 　　    A列    　　B列　　
 1行 項目名１　　　項目名2　
 2行 A店        　 リンゴ
 3行 B店           レモン
 4行 B店　         リンゴ
 5行 A店　         リンゴ　1行目と重複のでNG

 シート２
 　　A列       　　B列　　
 1行 項目名１　　　項目名2　
 2行 C店　         リンゴ
 3行 D店           レモン
 4行 E店　         リンゴ
 5行 B店　         レモン　2行目と重複のでNG

 であるとします。
 重複のチェック方法はいくつかありますが、Dictionaryオブジェクトを使う方法で
 考えます。

 標準モジュールに重複チェックを行うプログラムパック

 '===================================================================
 Option Explicit
 Private dic As Object
 Function dupchk_init() As Long
    On Error Resume Next
    Set dic = CreateObject("scripting.dictionary")
    dupchk_init = Err.Number
    On Error GoTo 0
 End Function
 Function dupchk(key As Variant) As Boolean
    dupchk = True
    If dic.Exists(key) Then
       dupchk = False
    Else
       dic.Item(key) = ""
    End If
 End Function
 Sub dupchk_term()
    Set dic = Nothing
 End Sub

 Thisworkbookのモジュールに

 '============================================================
 Option Explicit
 '============================================================================
 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Not 重複チェック Then Cancel = True
 End Sub
 '================================================================
 Function 重複チェック() As Boolean
    Dim g0 As Long
    Dim shtnm As Variant
    Dim rng As Range
    重複チェック = True
    If dupchk_init = 0 Then
       For Each shtnm In Array("sheet1", "sheet2")
                               '↑ここは、チェックする二つシート名を記述
          With Worksheets(shtnm)
             Set rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
          End With
          If rng.Row > 1 Then
             For g0 = 1 To rng.Count
                If Not dupchk(rng(g0).Value & Chr(&HFF) & rng(g0, 2).Value) Then
                   MsgBox shtnm & "の　　　" & g0 + 1 & "行目が重複"
                   重複チェック = False
                   Exit For
                End If
             Next
          End If
          If Not 重複チェック Then Exit For
       Next
       Call dupchk_term
    End If
    Set rng = Nothing
 End Function

 これで保存してみてください。重複データがあれば、その趣旨のメッセージが表示されます。

 ichinose

ichinose様へ

　返答ありがとうございます。
　下手な説明で理解していただき、ありがとうございます。

　実際に使用したところ問題なく動いてくれました。

 マクロって本当に色々な表現の仕方があり、
 複雑で面白いものだと思いました。

　上記のコードについて、質問があります。

　Set rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))

　シート1とシート２　A2から下すべて参照している？と思いますが、

 これをシート１とシート２別々に参照することは可能でしょうか？
 つまり、シート１のBCとシート２のCDのように変更が
 できないか考えましたが、私では無理のようです。

お手数すが、お願い致します。

 >シート１のBCとシート２のCDのように変更が
 >できないか考えましたが、私では無理のようです。
 重複チェックというFunctionで何をしているのか
 よく調べてみてください。
        For Each shtnm In Array("sheet1", "sheet2")
                               '↑ここは、チェックする二つシート名を記述
          With Worksheets(shtnm)
             Set rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
          End With
          If rng.Row > 1 Then
             For g0 = 1 To rng.Count
                If Not dupchk(rng(g0).Value & Chr(&HFF) & rng(g0, 2).Value) Then
                   MsgBox shtnm & "の　　　" & g0 + 1 & "行目が重複"
                   重複チェック = False
                   Exit For
                End If
             Next
          End If
          If Not 重複チェック Then Exit For
       Next
 この　For Each shtnm In Array("sheet1", "sheet2")
       ・
       ・
       next
  って
 最初の繰り返しでは、shtnmに　"sheet1" が入って処理がなされ、
 2回目の繰り返しでは、shtnmには、"sheet2"が入って処理がなされていること
 わかりますか？

 よって、shtnmの中身によって、
 rngにセットする内容を変えればよいですね！！
 こういう処理をする代表的なステートメントは　IF文です
 これで考えてみてください。

 ichinose

 追伸

 >Set rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp)) 
 >シート1とシート２　A2から下すべて参照している？と思いますが、

 アクティブシートのＡ列にいろんなパターンのデータを配置して
 以下のコードを実行して、表示されるセル範囲のアドレスを確認してください

 Sub sample()
    Dim rng As Range
    With ActiveSheet
       Set rng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
    End With
    MsgBox rng.Address
 End Sub

 例1
 Ａ列に何もデータがない(項目名以外）場合

 　　Ａ
 1   項目名

 例2
 普通にデータがある場合

 　　Ａ
 1   項目名
 2　　ああ
 3    いい
 4    うう
 5    ええ

 例3
 途中のどこかに未入力セルがある場合

 　　Ａ
 1   項目名
 2   あああ
 3   いいい
 4 
 5   えええ

 例4

 2行目から、最終行までデータがびっしり入っている場合

 1   項目名
 2   あああ
 3   いいい
 4   ううう 
 5   えええ
 ・
 ・
 65336 ｄｊｄｊｄ

 (実は、この場合は、正しくセル範囲を取得できません)

 これらの結果で考察してみてください。

 また、

        Set rng = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
 の箇所を
        Set rng = .Range("b2", .Cells(.Rows.Count, "b").End(xlUp))
 や
        Set rng = .Range("bc2", .Cells(.Rows.Count, "bc").End(xlUp))

 に変えて、対応する列にデータをいれて、試してみてください。

 これらの結果を踏まえて、後は、Helpなどで一つ一つのプロパティを
 調べてみてください。

 そうすれば、コードの意味に確信が持てると思います。

 ichinose

 >最初の繰り返しでは、shtnmに　"sheet1" が入って処理がなされ、
 >2回目の繰り返しでは、shtnmには、"sheet2"が入って処理がなされていること
 >わかりますか？

 shtnmに代入してるのはわかりました。
 そーなるとシート１、シート２同じセルを重複チェックしていることになりますよね？
 シート１ではBCをチェックし、シート１でチェックした文字列がシート２のCDでチェック
 できない気がしました。
 勉強不足ですいません。会社の方に無理に頼まれ、VBA出来ないっと言ったのですが、
 どうしてもやってくれと無理矢理押し付けられてしまいまして・・・OTL
 期限が明日までらしいです・・・とほほ
 お手数をかけて申し訳ないのですが、お付き合いをお願い致します。

シート１

 　  B列    　　C列　　
 1行 項目名１　　　項目名2　
 2行 A店        　 リンゴ
 3行 B店           レモン
 4行 B店　         リンゴ
 5行 A店　         リンゴ　NG

 シート２
 　　C列       　　B列　　
 1行 項目名１　　　項目名2　
 2行 C店　         リンゴ
 3行 D店           レモン
 4行 E店　         リンゴ
 5行 B店　         レモン　NG

 がんばってはいるのですが、どうにも・・・

 >With Worksheets(shtnm)
 >Set rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
 すいません、誤認してました。
 シート１のA2がA3をチェック→A2がA4をチェックと繰り返しているんですね。
 withを使い、シート２へ上記処理を渡しているってことですか！

 ってことは、シート1の処理をそのままシート２へ受け渡しては駄目なので・・・・
 withは使わない方がいい？・・・いや、シート１、シート２をいれてるだけなので、
 >Set rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
 を変更すれば、シート１　BC、シート２　CD　別々に列を比較できるようにできる？のかな

 本当に申し訳ないのですが、コードを提示をお願いしますOTL
 そのまま記載して頂いても勉強の為にはならないのですが、期限が・・・
 色々とお手数を掛けて本当に申し訳なくて申し訳なくて情けないです。

 Function 重複チェック() As Boolean
    Dim g0 As Long
    Dim shtnm As Variant
    Dim rng As Range
    重複チェック = True
    If dupchk_init = 0 Then
       For Each shtnm In Array("sheet1", "sheet2")
                                '↑ここは、チェックする二つシート名を記述
          With Worksheets(shtnm)
             If shtnm = "sheet1" Then
                Set rng = .Range("B2", .Cells(.Rows.Count, "B").End(xlUp))
             Else
                Set rng = .Range("C2", .Cells(.Rows.Count, "C").End(xlUp))
             End If
          End With
          If rng.Row > 1 Then
             For g0 = 1 To rng.Count
                If Not dupchk(rng(g0).Value & Chr(&HFF) & rng(g0, 2).Value) Then
                   MsgBox shtnm & "の　　　" & g0 + 1 & "行目が重複"
                   重複チェック = False
                   Exit For
                End If
             Next
          End If
          If Not 重複チェック Then Exit For
       Next
       Call dupchk_term
    End If
    Set rng = Nothing
 End Function
とりあえずためしてみて

 京大カンニング事件以降、投稿の仕方を模索しています。
 今回のご質問、考えた結果、私の投稿はこれで止めさていただきます。

 一つだけ
 >期限が明日までらしいです
 これは、私には関係のない話です。

 尚、一つ上の投稿は、私ではありません
 ichinose

コメント返信：

[ 一覧(最新更新順) ]

[[20110406004708]] 『２シート間での重複チェック』（目から鱗） ページの最後に飛ぶ

[[20110406004708]]　『２シート間での重複チェック』（目から鱗）　ページの最後に飛ぶ