Excel VBについての質問です。

Question

今Vlookupで行っているのですが効率が悪いのでマクロで自動化したいと思っています。
それぞれの情報をDシートEシートに張り付けて、AシートBシートに検索に必要な情報だけを抜き出すまではできたのですが。。

得意先に出す請求書を作る際に先方から送られてきた検収書と自社の受注表に差異が無いのか確認したいと思っています。
AのシートBのシートともにA列に注文番号　B列に金額を入れて、どちらかで合致する注文番号が無いものや金額が違うものをCのシートに抜き出す。その際にABどちらに差異があるのか目視で確認できるようにしたいと思っているのですが…

詳しい方いらっしゃいましたら回答の程よろしくお願いいたします。

tatsumaru77 · Accepted Answer

下記URLにアップしました。
標準モジュールに登録してください。
マクロは、「相違」シートの3行目以降から出力します。
見出し行は予め、あなたが作成しておいてください。
https://ideone.com/NNAKhJ

tatsumaru77 · Answer

補足確認しました。最終確認です。

エラーケース毎の相違理由の出力確認です。
case1 得意先に注文番号があり、自社に注文番号がない場合　　　　　　　　　　　　　　　　G列＝Ｂ注番なし　　P列＝空白
case2 得意先に注文番号がなく、自社に注文番号がある場合　　　　　　　　　　　　　　　　G列＝空白　　　　　P列＝Ａ注番なし
case3 得意先に注文番号があり、自社に注文番号があり、単価が異なる場合　　　　　　　　　G列＝単価違い　　　P列＝単価違い
case4 得意先に注文番号があり、自社に注文番号があり、単価が同じだが、個数が異なる場合　G列＝個数違い　　　P列＝個数違い

上記で間違いないでしょうか。（単価違い、個数違いは、単価違いを優先的に判定する。理由は、G列、P列に同じ内容を出力する）

上記の得意先と自社の比較以前に、得意先のシートに異常がある場合は、その旨をエラー表示して、処理を打ち切ります。
その場合、得意先と自社の比較は行いません。
（注文番号が空白の場合、単価が空白の場合、個数が空白の場合、同一の注文番号が得意先のシートに複数存在する場合のケースです）
同様に、自社のシートに異常がある場合は、その旨をエラー表示して、処理を打ち切ります。（エラー内容は得意先と同様）
上記の仕様で宜しいでしょうか。

tatsumaru77 · Answer

画像拝見しました。残念ながら、画像が不鮮明なため、仕様が理解できません。
もう一度、左側の画像と右側の画像を再度、別々にアップしていただけませんでしょうか。
そうすれば、多少鮮明な画像になり、仕様が理解できるようになるかと思います。

もし、画像を別々にアップするのが、難しいようでしたら、以下の不明点に補足してください。

１．左側の画像は、Aシート及びBシートでしょうか？（２つのシートは同じレイアウトである前提）
そうでしたら、
①列C、D、Eの項目名を提示してください。（どれかが注文番号と金額かと推測していますが、読み取れません）
項目が１つ増えたということは、注文番号と金額のほかに、更に比較するものが１つ増えたと理解して良いですか。
②Aシートの実際のシート名を提示してください。
③Bシートの実際のシート名を提示してください。
④以下の前提で良いでしょうか。
　データは2行目から開始しており、空白行はないことが前提である。（空白行はエラーとする）
　最終行の決定はA列で判定する。

２．右側の画像はCシートでしょうか？
そうでしたら
①シート名を提示してください。
②以下の前提であってますか。
　A列～G列はAシート側のデータ、J列～P列はBシート側のデータである。
　３行目からデータが出力される。（１～２行目は見出し行）
③G列とP列に設定する相違理由が読み取れません。ケース毎に相違理由を提示していただけませんでしょうか。
Case1 注文番号がAシートにありBシートにない。
Case2 注文番号がAシートになくBシートにある。
Case3 注文番号がAシートにありBシートにもあるが、金額が異なる。
Case4 注文番号がAシートにありBシートにもあり、金額も同じだが、？？が異なる。（？？は新規の比較項目）

上記の場合に出力する相違理由を提示してください。
また、上記以外のケースがあれば、そのケースも提示してください。

fujillin · Answer

こんにちは VBAのご質問ですけれど・・失礼ながら、質問者様が扱えないマクロ（＝ブラックボックス）を利用すると、メンテ不可能になりますし、微妙な違いがあっても手を付けられないことになります。＞Vlookupで行っているのですが効率が悪い～関数が使えるのなら、効率を改善する工夫をすればよさそうに思います。勝手に関数利用の例を作成してみましたが、シートのレイアウトも最終形も不明なので、1シート内での例示にしてあります。Ａ、Ｂのそれぞれのシート内には注文番号の重複は無いものと仮定しました。考え方として、不一致の注文番号（他方に存在しない番号を含む）をピックアップできさえすれば、後はさほど難しくはないものと思います。Ａシート（どちらでも良いですが仮にＡシート）の各注文番号でＢシートを検索し金額が一致しない番号、存在しない番号を抽出します。これに、Ｂシートにしか存在しない番号を加えれば、不一致の番号を全て抽出できたことになります。この処理を一気にやろうとすると、少々複雑な式になってしまいますが、上記の内容を順に求めてゆけばさほど難しくはないはずと思います。添付図では、ＡＢ列がＡシート、ＤＥ列がＢシート、Ｇ～列がＣシートと仮定してあります。Ｃシートで何を表示したいのかも不明なので、ひとまずＡ、Ｂシートの金額を表示するようにしてあります。（例示では、不一致や抜けている番号をわざと多くしてありますが・・）また、添付図ではOffice365等のバージョンを想定しています。Ｇ3セルに（まとめて処理しているので、式が少々複雑になっていますが） =SORT(VSTACK(FILTER(A3:A99,IFERROR(VLOOKUP(A3:A99,D3:E99,2,0)<>B3:B99,1)*(A3:A99<>""),""),FILTER(D3:D99,ISERROR(MATCH(D3:D99,A3:A99,0))*(D3:D99<>""),""))) Ｈ3セルに =IFERROR(VLOOKUP(G3#,A:B,2,0),"記載なし") を入力してあります。（Ｉ3セルは同様なので省略） ※ 抽出範囲に自動でスピルされますので、式の設定は3セルだけ済みます。 ※ シートが別の場合は、セルの指定方法が変わるだけですね。 ※ 両シートが一致している場合は「記載なし、記載なし」が2回連続しますが、そのあたりはお好みの表示に変更してください。（"OK"にして空白にするとか）ご参考にでもなれば・・

tatsumaru77 · Answer

>画像の補足をいたします。
画像が表示されていません。ご確認をお願いします。

tatsumaru77 · Answer

いくつか不明点があるので、補足要求になります。
１．マクロで、参照／更新するのは、Aシート、Bシート、Cシートのみで、
Ｄシート、Ｅシートについては、マクロは関知しませんが、その認識であってますか。

２．Aシート、Bシートの正確なレイアウトが判らないとマクロは、作成できません。添付図のようなレイアウトが判るものを提示していただけませんでしょうか。
添付図では、左側がＡシート、右側がＢシートとしています。
レイアウトが全く同じであれば、片方のシートの画像のみでも構いません。
①見出し行があるのか。
②Ａシートの４行目のような空白行があるのか。
等の情報があなたから提示された文章では読み取れませんでしたので、画像の提供をお願いした次第です。

３．Aシート、Bシートの違いで考えられるケースは以下のようになります。
①注文番号がAシートにあり、Bシートにないケース
②注文番号がAシートになく、Bシートにあるケース
③注文番号がAシート、Bシートに共にあるが、金額が異なっているケース。

上記の３ケースの場合、Ｃシートにどのように出力するのか、
そのサンプルを画像で提示してください。

４．Aシート、Bシート、Ｃシートの実際のシート名を提示してください。
添付の画像では、ＡシートがSheet1、BシートがSheet2になっています。

河内のおやじ · Answer

Sub CompareOrders()
    Dim wsA As Worksheet, wsB As Worksheet, wsC As Worksheet
    Dim lastRowA As Long, lastRowB As Long, lastRowC As Long
    Dim i As Long, j As Long
    Dim orderA As String, orderB As String
    Dim amountA As Double, amountB As Double
    Dim found As Boolean
    
    ' シートの設定
    Set wsA = Worksheets("Aシート")
    Set wsB = Worksheets("Bシート")
    Set wsC = Worksheets("Cシート")
    
    ' 各シートの最終行を取得
    lastRowA = wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row
    lastRowB = wsB.Cells(wsB.Rows.Count, "A").End(xlUp).Row
    lastRowC = 1 ' Cシートの書き込み開始行
    
    ' Cシートのヘッダーを設定
    wsC.Cells(1, 1).Value = "注文番号"
    wsC.Cells(1, 2).Value = "Aシート金額"
    wsC.Cells(1, 3).Value = "Bシート金額"
    wsC.Cells(1, 4).Value = "差異のあるシート"
    lastRowC = lastRowC + 1
    
    ' AシートとBシートを比較
    For i = 2 To lastRowA ' ヘッダー行を除くため2行目から開始
        orderA = wsA.Cells(i, 1).Value
        amountA = wsA.Cells(i, 2).Value
        found = False
        
        For j = 2 To lastRowB
            orderB = wsB.Cells(j, 1).Value
            amountB = wsB.Cells(j, 2).Value
            
            If orderA = orderB Then
                found = True
                If amountA <> amountB Then
                    ' 金額が違う場合
                    wsC.Cells(lastRowC, 1).Value = orderA
                    wsC.Cells(lastRowC, 2).Value = amountA
                    wsC.Cells(lastRowC, 3).Value = amountB
                    wsC.Cells(lastRowC, 4).Value = "金額が違う"
                    lastRowC = lastRowC + 1
                End If
                Exit For
            End If
        Next j
        
        If Not found Then
            ' Aシートにのみ存在する注文番号
            wsC.Cells(lastRowC, 1).Value = orderA
            wsC.Cells(lastRowC, 2).Value = amountA
            wsC.Cells(lastRowC, 3).Value = "無し"
            wsC.Cells(lastRowC, 4).Value = "Aシートのみ"
            lastRowC = lastRowC + 1
        End If
    Next i
    
    ' Bシートにのみ存在する注文番号をチェック
    For j = 2 To lastRowB
        orderB = wsB.Cells(j, 1).Value
        amountB = wsB.Cells(j, 2).Value
        found = False
        
        For i = 2 To lastRowA
            orderA = wsA.Cells(i, 1).Value
            If orderA = orderB Then
                found = True
                Exit For
            End If
        Next i
        
        If Not found Then
            ' Bシートにのみ存在する注文番号
            wsC.Cells(lastRowC, 1).Value = orderB
            wsC.Cells(lastRowC, 2).Value = "無し"
            wsC.Cells(lastRowC, 3).Value = amountB
            wsC.Cells(lastRowC, 4).Value = "Bシートのみ"
            lastRowC = lastRowC + 1
        End If
    Next j
    
    MsgBox "比較が完了しました。"
End Sub

kigoshi · Answer

少しでもソースコードを書いたのならそれをご提示下さい。

> その際にABどちらに差異が

ここでいうABというのはシートですか、列ですか？

Excel VBについての質問です。

下記URLにアップしました。

補足確認しました。

画像拝見しました。

こんにちは

>画像の補足をいたします。

いくつか不明点があるので、補足要求になります。

Sub CompareOrders()

少しでもソースコードを書いたのならそれをご提示下さい。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング