[[20190131130314]]　『データの一致、不一致』（あめ）　ページの最後に飛ぶ

『データの一致、不一致』（あめ）

2つの表を比較を照合して名前と金額が一致していたら「OK」、
不一致の場合は「FALSE」としたいです。

参考になりそうなコードを見つけたのですがマクロが始めてで
自分のやりたいことへの直し方が分かりません。

どこを直した方がよいのか教えていただけないでしょうか。

参照先シートの表のそれぞれの項目の金額が正しいことを各検証シートで
検証しております。

検証シートのA列とB列は検証結果です。
この検証結果と参照先シートが一致しているかどうか、検証シートのC列に
結果を表示させたいです。

検証シートで名前と金額が漏れている場合、何か知る方法はあるのでしょうか。

どんなことでもよいので　ご指導お願いいたします。

（参照先シート）
___＿A＿__＿B__＿＿C＿＿＿D__＿_＿E___

1 名前　りんご　ばなな　いちご　みかん
2 田中　　100　　　　80 　　　　　　　　60
3 松田　　20　　　　　　　　50　　　　100
4 佐藤
5 山田　　30　　　　130　　　60　　　　80
6 鈴木　　　　　　　　70　　　150

（りんご検証シート）
___＿A＿__＿B__＿＿C＿＿＿D__＿_＿E___

1 名前　りんご　結果
2 田中　　100　　　OK 　　　　　　　　
3 松田　　20　　　OK
4 山田　　30　　　　OK　　　

 Sub sample2_2()
    Dim hida As Long
    Dim migi As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Set ws1 = Worksheets("sample2_1")
    Set ws2 = Worksheets("sample2_2")

    For migi = 2 To 11
        For hida = 2 To 21
            If ws2.Range("A" & migi).Value = ws1.Range("B" & hida).Value Then
                ws1.Range("C" & hida).Value = "OK"
                Exit For
            End If
        Next
    Next

    For hida = 2 To 21
        If ws1.Range("C" & hida).Value = "" Then
            ws1.Range("C" & hida).Interior.Color = vbYellow
        Else
            ws1.Range("C" & hida).Interior.Color = xlNone
        End If
    Next
End Sub

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 ＞         If ws2.Range("A" & migi).Value = ws1.Range("B" & hida).Value Then
一方のA列と他方のB列を比較していますが、A列は名前、B列は数値なので、一致するはずはないですよね？
ws1とws2のA列同士、B列同士が両方共一致して、初めてOKになるのでは？
（???） 2019/01/31(木) 14:47

 ぶつかり。

 マクロが良いんでしょうか？
 Vlookupで、すみそうな気もします。
 因みに、マクロで書けと言われたら、やっぱりVlookup使っちゃいます。
（BJ） 2019/01/31(木) 14:52

 数式だと、こんな感じ？？
 =IF(VLOOKUP($A2,参照先シート!$A$1:$E$6,MATCH($B$1,参照先シート!$1:$1,0),0)=$B2,"OK",False)
（BJ） 2019/01/31(木) 15:08

 ＞検証シートで名前と金額が漏れている場合、何か知る方法はあるのでしょうか。 
 これって、検証シートには名前・商品名・金額があらかじめ入力されていて、
 参照先シートに「無い」ものを見つけるんですか？
 それとも
 検証シートに「無い」ものを見つけるんですか？

 田中さんが二人いたりしませんか？

 二人いた場合、合算でしょうか？
 別の場合、どのように見分けたらよいですか？
（稲葉） 2019/01/31(木) 15:15

皆さまご回答ありがとうございます。

今はVLOOKUPでやっているのですが式を壊す人がいるので毎回修正しておりましたら
データも多く時間がかかるのでマクロで作成するように言われました。

でもマクロ作ったことが無いので　このコードで大丈夫かも分からず
こちらに相談させていただきました。

どんなことでもよいので教えていただけないでしょうか。
よろしくお願いいたします。

 ＞これって、検証シートには名前・商品名・金額があらかじめ入力されていて、
 参照先シートに「無い」ものを見つけるんですか？
 それとも検証シートに「無い」ものを見つけるんですか？

検証シートには名前・商品名・金額があらかじめ入力されております。
検証シートに無いものを見つけたいです。

 ＞田中さんが二人いたりしませんか？

いません。

（あめ） 2019/01/31(木) 16:42

 ＞今はVLOOKUPでやっているのですが式を壊す人がいるので毎回修正しておりましたら 
 ＞検証シートに無いものを見つけたいです。 
 ん？

 Vlookupでチェックしたときに、BJさんの数式でチェックしたとして、検証シートにない人はチェックできなくないですか？
 仮に参照先シートに鈴木さんがりんごを10円買っていたとして
 今回の検証シートに鈴木さんは居ないので、すべてＯＫとなってしまいますよね？
 本来は鈴木さんがいなくてはいけないわけですよね？

 現在使っている数式を提示していただけませんか？
（稲葉） 2019/01/31(木) 16:55

稲葉様

ご回答ありがとうございます。

 ＞仮に参照先シートに鈴木さんがりんごを10円買っていたとして
 今回の検証シートに鈴木さんは居ないので、すべてＯＫとなってしまいますよね？
 本来は鈴木さんがいなくてはいけないわけですよね？

そうなのです。
これだと漏れていることになるので何か分かる方法があればと思ったのですが。

 ＞現在使っている数式を提示していただけませんか？

式を壊すというのは式を消すという意味です。
関数だと使えない人がいるのでマクロで見えなくしてほしいとの要望です。

IF(O24='◎(検証!Q11,"OK")

どんなことでもよいので教えていただけないでしょうか。
よろしくお願いいたします。

（あめ） 2019/01/31(木) 17:12

???様

ご回答ありがとうございます。

 ＞一方のA列と他方のB列を比較していますが、A列は名前、B列は数値なので、一致するはずはないですよね？
ws1とws2のA列同士、B列同士が両方共一致して、初めてOKになるのでは？

こういうことでしょうか。
If ws2.Range("A" & migi).Value = ws1.Range("A" & hida).Value Then

A列とB列セットで一致した場合にOKとしたいのですが大丈夫でしょうか。

どんなことでもよいので教えていただけないでしょうか。
よろしくお願いいたします。
（あめ） 2019/01/31(木) 17:17

 これだと
 =IF(VLOOKUP($A2,参照先シート!$A$1:$E$6,MATCH($B$1,参照先シート!$1:$1,0),0)=$B2,"OK",False)

 名前がない場合、 #N/A
 数値が無い場合、FALSE
 となって、区別がつきませんか。
 数式の入っているセルは、シート保護するか、入力規則で対応。

 >関数だと使えない人がいるので
 どういう意味で言っているのか良くわからないです。
（BJ） 2019/01/31(木) 17:24

 ＞ If ws2.Range("A" & migi).Value = ws1.Range("A" & hida).Value Then
これだと、名前が一致しただけでOKになっちゃいますよね？
なので、このIf文に引っかかったならば、続けてB列も同様に比較しましょう。

            If ws2.Range("A" & migi).Value = ws1.Range("A" & hida).Value Then
                If ws2.Range("B" & migi).Value = ws1.Range("B" & hida).Value Then
                    ws1.Range("C" & hida).Value = "OK"
                Else
                    ws1.Range("C" & hida).Value = "FALSE"
                End If
                Exit For
            End If
（???） 2019/01/31(木) 17:28

 私の認識で書きました。
 下記のような結果でよければ、お試しください。
    |[A] |[B]   |[C]                 
 [1]|名前|りんご|山田さんがいません  
 [2]|田中|   100|OK                  
 [3]|松田|    10|金額が違っています。

    |[A] |[B]   |[C]                     
 [1]|名前|ばなな|                        
 [2]|田中|    80|OK                      
 [3]|松田|      |参照先に名前がありません
 [4]|佐藤|      |参照先に名前がありません
 [5]|山田|   130|OK                      
 [6]|鈴木|    70|OK

 ■前提条件
 各検証シート名は、参照先シートの1行目に入力があること。（りんご、ばなな、いちご、みかん）
 各検証シートが保護されていないこと
    Sub 検証()
        Dim tbl As Variant
        Dim f As Range
        Dim msg As String
        Dim i As Long
        Dim n As Long
        Dim r As Range
        Dim ws As Worksheet
        tbl = Sheets("参照先").Range("A1").CurrentRegion.Value
        For i = 2 To UBound(tbl, 2)
            Set ws = Nothing
            On Error Resume Next
            Set ws = Sheets(tbl(1, i))
            On Error GoTo 0
            If Not ws Is Nothing Then
                msg = ""
                '//C列のリセット
                ws.Range("C:C").ClearContents

                '//参照先にデータがある人を、検証から探す
                For n = 2 To UBound(tbl, 1)
                    If tbl(n, i) > 0 Then
                        Set f = ws.Range("A:A").Find(tbl(n, 1))
                        If f Is Nothing Then
                            '★参照先に金額があるが、検証にない場合
                            msg = msg & "," & tbl(n, 1)
                        ElseIf f.Offset(, 1).Value <> tbl(n, i) Then
                            '★参照先金額と、検証の金額が異なる場合
                            f.Offset(, 2).Value = "金額が違っています。"
                        Else
                            '★参照先と検証の金額が一致している場合
                            f.Offset(, 2).Value = "OK"
                        End If
                    End If
                Next n

                '★検証に名前があり、参照先に金額がない場合　※シートが保護されているとエラーになります。
                Set r = ws.Range("C2:C" & ws.Cells(Rows.Count, "A").End(xlUp).Row)
                If WorksheetFunction.CountBlank(r) > 0 Then
                    r.SpecialCells(xlCellTypeBlanks).Value = "参照先に名前がありません"
                End If
            Else
                Debug.Print tbl(1, i) & "のシートが見当たりません"
            End If
            If msg <> "" Then ws.Range("C1").Value = Mid$(msg, 2) & "さんがいません"
        Next i
    End Sub

（稲葉） 2019/01/31(木) 18:17

BJ様

ご回答ありがとうございます。

教えていただいた式だと区別できますね。

でも今回はマクロで作成しようと思います。
今後の為に参考にさせていただきます。

 〉どういう意味で言っているのか良くわからないです。

私の周りは関数のエラーが出た時、対処できない方ばかりなんです。
コメントど対処方を入力していてもダメなのです。

ご丁寧にご指摘いただきましてありがとうございました。
（あめ） 2019/01/31(木) 20:36

？？？様

ご回答ありがとうございます。

 〉これだと、名前が一致しただけでOKになっちゃいますよね？

そうだったのですねすいません。
IfでAの時と同じようにしたらよいのですね。

勉強になりました。
明日会社で試してみます。

（あめ） 2019/01/31(木) 20:47

稲葉様

ご回答ありがとうございます。

ご丁寧にコードの解説までしていただきまして助かります。

明日会社で試してみます。
とり急ぎご連絡いたします。

（あめ） 2019/01/31(木) 20:54

 横から失礼します。
 勉強させてもらっております。

 稲葉さんのコードで試してみたのですが一部できませんでした。

 参照先と一致しているのに「金額が違ってます」と「参照先に名前がありません」
 と結果が出てしまいました。

 簡単なテストデータでは大丈夫でしたが、自分の持っているデータで試してみたらダメでした。

 何か考えられる原因がありましたら　ご教授ください。

（初心者） 2019/02/01(金) 16:34

 データがないのに検証できないです。
 こちらではテストデータで問題ないものを提供しています。
（稲葉） 2019/02/01(金) 17:08

Sub main()

    Dim c As Range, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    For Each c In Sheets("参照先").Range("A1").CurrentRegion
        dic(c.EntireRow.Cells(1) & "|" & c.EntireColumn.Cells(1) & "|" & c.Value) = True
    Next c
    For Each c In Sheets("りんご検証").Range("A2:A" & Rows.Count).SpecialCells(2)
        If dic(c.Value & "|" & Range("b1").Value & "|" & c.Offset(, 1).Value) Then
            c.Offset(, 2).Value = "OK"
        Else
            c.Offset(, 2).Value = "FALSE"
        End If
    Next c
End Sub
（mm） 2019/02/01(金) 17:18

 （初心者） 2019/02/01(金) 16:34さんあて
 もし心当たりがあるなら、Findのところです。
 Findメソッドは、前回の設定を引き継ぐため、引数を省略した場合は前回の設定のままになります。
 ですので、手動で検索したときに引っ掛からない場合もございます。（値ではなく、計算式の中を検索するなど）
 Dictionary版を作りましたので、ご確認ください。
    Sub 検証2()
        Dim w As Variant
        Dim dic As Object
        Dim i As Long
        Dim j As Long
        Dim r As Range
        Dim k As Variant
        Dim kk As Variant
        Dim ws As Worksheet
        Dim msg As String
        '項目別に金額が入っている人をdicに登録する　例：dic(りんご)(田中) = 80
        w = Sheets("参照先").Range("A1").CurrentRegion.Value
        Set dic = CreateObject("Scripting.Dictionary")
        For j = 2 To UBound(w, 2)
            Set dic(w(1, j)) = CreateObject("Scripting.Dictionary")
            For i = 2 To UBound(w, 1)
                If w(i, j) <> "" Then
                    dic(w(1, j))(w(i, 1)) = w(i, j)
                End If
            Next i
        Next j

        '項目名でループする
        For Each k In dic.keys
            'シートの有無チェック
            Set ws = Nothing
            On Error Resume Next
            Set ws = Sheets(k)
            On Error GoTo 0
            If Not ws Is Nothing Then
                'C列のリセット
                ws.Range("C:C").ClearContents
                'A2からA列の最終行までループ
                For Each r In ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
                    Select Case True
                        Case Not dic(k).exists(r.Value)
                            '★参照先に金額がない場合
                            r.Offset(, 2).Value = "参照先に金額がありません"

                        Case dic(k)(r.Value) = r.Offset(, 1).Value
                            '★金額が一致していた場合
                            r.Offset(, 2).Value = "OK"

                        Case Else
                            '★参照先と金額が異なる場合
                            r.Offset(, 2).Value = "参照先と金額が合いません"
                    End Select
                    If dic(k).exists(r.Value) Then dic(k).Remove (r.Value)
                Next r

                '★参照先に金額があるが、検証にない場合（一度も名前を呼ばれていない人）
                If dic(k).Count > 0 Then
                    msg = ""
                    For Each kk In dic(k).keys
                        msg = msg & "," & kk
                    Next kk
                    ws.Range("C1").Value = Mid$(msg, 2) & "さんがいません"
                End If
            Else
                Debug.Print k & "のシートが見当たりません"
            End If
        Next k
        Set dic = Nothing
    End Sub

（稲葉） 2019/02/01(金) 19:00

稲葉　様

遅くなりまして申し訳ございません。
自分仕様に変更するのに手間取ってしまい、お礼が遅れてしまいました。

まだ分からない所がありますが少しづつ勉強してみようと思います。

どうもありがとうございます。

（あめ） 2019/02/04(月) 09:55

 参考までに、どこを直したか教えていただけますか？
 自分の認識とあっていたかどうかくらい、教えていただきたいです。
（稲葉） 2019/02/04(月) 10:12

 （稲葉） 2019/02/01(金) 19:00さんあて

 初心者です。
 度々、横から失礼いたします。

 ＞Dictionary版を作りましたので、ご確認ください。

 質問者ではないのにご対応いただきまして、ありがとうございます。
 自分の持っているデータでも大丈夫でした。

 ＞もし心当たりがあるなら、Findのところです。

 前回の設定を引き継ぐとは知らなかったです。
 勉強になります。
 何度も繰り返す場合はFind使わない方が良いですね。
 他のコードも見直してみます。

 まだまだ教えていただきたいことがあるのですが、こちらあめさんの
 質問なので新しく登録させていただきます。

 どうもお邪魔いたしました。

（初心者） 2019/02/04(月) 13:09

 ＞ 何度も繰り返す場合はFind使わない方が良いですね。
 いえ、Findもすべての引数を省略しなければ、希望通りの結果になります。
 今回はさぼっただけです。

 もこな２さんも度々ご指摘されておりますが、Findに関しては名前付き引数の名前の省略や、
 引数そのものの省略はしないほうが良いというのが認識です。

 ＞ まだまだ教えていただきたいことがあるのですが、こちらあめさんの
 ＞質問なので新しく登録させていただきます。
 よろしければ一般名称（初心者）ではない、一意のハンドルネームでお願いします。
 私でよければ付き合います。

（稲葉） 2019/02/04(月) 18:36

 （稲葉） 2019/02/04(月) 18:36さんあて

 お邪魔します。
 初心者です。

 ＞Findに関しては名前付き引数の名前の省略や、引数そのものの省略は
 しないほうが良いというのが認識です。

 私の勘違いを教えていただきましてありがとうございます。
 またまた勉強になりました。
 マクロノート（勉強用）に記録しておきます。

 ＞よろしければ一般名称（初心者）ではない、一意のハンドルネームでお願いします。
 私でよければ付き合います。

 ご親切にありがとうございます。
 自分でもDictionaryやFind勉強しておきます。

 ハンドルネーム失礼しました「初心者」似た方が何人もいらっしゃいますね。
 ハンドルネームは「すもも」でお邪魔する予定です。
 機会がありましたら又よろしくお願いいたします。

 ご厚意に感謝いたします。

（初心者） 2019/02/05(火) 16:36

コメント返信：

[ 一覧(最新更新順) ]

[[20190131130314]] 『データの一致、不一致』（あめ） ページの最後に飛ぶ

[[20190131130314]]　『データの一致、不一致』（あめ）　ページの最後に飛ぶ