【VBA EXCEL データ有無行判定】エクセルの勉強をしていて行き詰まってしまったので相談さ

Question

マジレス希望

【VBA EXCEL データ有無行判定】エクセルの勉強をしていて行き詰まってしまったので相談さ

解決済

質問者：raichan18
質問日時：2017/10/03 19:00
回答数：6件

【VBA EXCEL データ有無行判定】

エクセルの勉強をしていて行き詰まってしまったので相談させて下さい。

大まかな概要としては、シートAにあるデータがシートBにあればシートAのD列に○、なければ×と、出力する処理をしたいです。

シートAにあるデータがシートBにあるかただ検索して判定するのであれば自分で関数などを使用し処理ができたのですが、
①両シートのデータ数は毎回可変
②シートAにあるデータが必ずしもシートBにあるとは限らない
③データ数が膨大
④シートBには重複するデータもある
なことから処理方法がわからず完全に手が止まっている状況です。

<シートA>
A列 B列 C列 D列
りんご青森 300 ○
りんご青森 400 ○
りんご岩手 500 ×
みかん山形 1000 ○
みかん山形 5000 ×

<シートB>
A列 B列 C列
りんご青森 300
りんご青森 400
りんご岩手 400
みかん山形 1000
ぶどう山梨 500
ぶどう山形 1000
・
・
・
みかん山形 500

うまく説明が出来ず大変申し訳ありませんが、お助けいただけないでしょうか。
周りにスキルのある方がおらず、自力で学習するしかありません。
不足部分については補足させて頂きますのでどうぞよろしくお願い致します。

通報する

tom04 · Accepted Answer

No.1・2です。

No.1の件について・・・
↓の画像のように「B」シートのD列に通番が入っているというコトでしょうか？
そして「A」シートの「○」の行のE列にその通番を表示したい！と解釈しました。

VBAでやってみました。
「A」シートのデータ数が最大300件程度というコトなので今回はループさせる方法です。
前回のコードは消去し、↓のコードにしてみてください。

Sub Sample2()
    Dim i As Long, lastRow1 As Long, lastRow2 As Long
    Dim c As Range, myStr As String, wS As Worksheet
    Set wS = Worksheets("B")
        Application.ScreenUpdating = False
        lastRow2 = wS.Cells(Rows.Count, "A").End(xlUp).Row
            wS.Range("E:E").Insert
                Range(wS.Cells(2, "E"), wS.Cells(lastRow2, "E")).Formula = "=A2&B2&C2"
                With Worksheets("A")
                    lastRow1 = .Cells(Rows.Count, "A").End(xlUp).Row
                    Range(.Cells(2, "D"), .Cells(lastRow1, "E")).ClearContents
                    For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
                        myStr = .Cells(i, "A") & .Cells(i, "B") & .Cells(i, "C")
                        Set c = wS.Range("E:E").Find(what:=myStr, LookIn:=xlValues, lookat:=xlWhole)
                            If c Is Nothing Then
                                .Cells(i, "D") = "×"
                            Else
                                With .Cells(i, "D")
                                    .Value = "○"
                                    .Offset(, 1) = c.Offset(, -1)
                                End With
                            End If
                    Next i
                End With
                wS.Range("E:E").Delete
                Application.ScreenUpdating = True
                MsgBox "完了"
End Sub

こんな感じではどうでしょうか？m(_ _)m

tom04 · Answer

続けてお邪魔します。

＞作ってくださったイメージそのものです
というコトなので解決ではないのでしょうか？

＞教えていただけるととてもうれしいです。
＞よろしくお願い致します。

とは何をお答えすれば良いのかちょっと判りかねます。

①　VBAそのものの操作方法
②　コードの意味

①の場合は基本的なコトなので、
失礼にあたると思いNo.2に「標準モジュールにしてください。」としか記載していません。

②VBAのコードそのものの説明が必要なのでしょうか？

などが判ればお答えできる範囲で可能です。m(_ _)m

tatsu99 · Answer

>シートAで最大300件程度です。
>シートBはちなみに1500件程度です。
それならNo2のかたの方法で問題ないかと思います。
データが10万行以上であれば、他の方法を提示するつもりでしたが、そこまでのデータ量ではないので、No2の方の方法を採用してください。

tatsu99 · Answer

「データ数が膨大」とのことですが、シートAでおよそ何行ありますか。

tom04 · Answer

No.1です。

どうも失礼しました。
VBAでの方法をご希望なのですね？

ループする方法もありますが、データ量が膨大！というコトですので
ワークシート関数を使う方法にしてみました。
尚、両シートとも1行目は項目行でデータは2行目以降にあるという前提です。
標準モジュールにしてください。

Sub Sample1()
    Dim lastRow1 As Long, lastRow2 As Long, wS As Worksheet
        Set wS = Worksheets("B")
            Application.ScreenUpdating = False
            lastRow2 = wS.Cells(Rows.Count, "A").End(xlUp).Row
            wS.Range("D:D").Insert
                Range(wS.Cells(2, "D"), wS.Cells(lastRow2, "D")).Formula = "=A2&B2&C2"
                With Worksheets("A")
                    lastRow1 = .Cells(Rows.Count, "A").End(xlUp).Row
                        With Range(.Cells(2, "D"), .Cells(lastRow1, "D"))
                            .Formula = "=IF(COUNTIF(B!D:D,A2&B2&C2),""○"",""×"")"
                            .Value = .Value
                        End With
                End With
            wS.Range("D:D").Delete
            Application.ScreenUpdating = True
End Sub

※　シート名は「A」と「B」にしています。
こんな感じではどうでしょうか？m(_ _)m

tom04 · Answer

こんばんは！

シートBは「Sheet2」とし、シートAの1行目は項目行でデータは2行目以降にあるとします。
D2セルに
=IF(COUNTIFS(Sheet2!A:A,A2,Sheet2!B:B,B2,Sheet2!C:C,C2),"○","×")
という数式を入れフィルハンドルでダブルクリックしてみてください。