【VBA】辞書にリストを格納する(売掛入金明細の照合)

エクセルを使って、入金明細と売上明細の照合をする時に便利&時短なVBAを紹介します。

伝票番号などのキーとなる項目を「辞書」に格納して照合していきます。

毎月毎月、大量の入金明細を自社の売上データと照合しないといけないんです。
ものすごい作業時間だし、目も痛くなるし、肩も凝るし、消込みにミスがあると最悪のパターンで最初からやり直すハメになるしで、なんとかなりませんか。

今月が終わったと思ったらすぐに次月のデータが届きますよね。
こういた規則性のあるデータ同士の照合はある程度機械にまかせて、最後の手直しだけ人の手で行えるようにしてしまいましょう。

上手くできる方法があるんですね!

基本的な例題で紹介するので、あとは実態に沿うように変更してみてください。どう変更したらいいかわからない場合は質問にお答えしますよ。

目次

サンプル例題

Sheet1:自社の売上データ
A列:売上日付
B列:伝票番号
C列:商品名
D列:金額

Sheet2:取引先からの入金データ
A列:伝票番号
B列:仕入日付
C列:商品コード
D列:商品名
E列:金額

Sheet1、Sheet2ともに1行目はタイトル
キーとなるタイトルは「伝票番号」とする

売上データと入金データを照合するVBA

Sub 照合()

Dim myDic As Object
Dim myKey, c, varData As Variant
Dim a, b, e, r, g, h, j As Long
Dim aa, ab, ba, bb As Range

Set myDic = CreateObject(“Scripting.Dictionary”)

With Sheets(“Sheet1”)
    varData = .Range(“B2”, .Range(“B” & Rows.Count).End(xlUp)).Value
End With

For Each c In varData
    If Not c = Empty Then
        If Not myDic.Exists(c) Then
            myDic.Add c, Null
        End If
    End If
Next

With Sheets(“Sheet2”)
    varData = .Range(“A2”, .Range(“A” & Rows.Count).End(xlUp)).Value
End With

For Each c In varData
    If Not c = Empty Then
        If Not myDic.Exists(c) Then
            myDic.Add c, Null
        End If
    End If
Next

myKey = myDic.Keys

e = Worksheets(“Sheet1”).Cells(Rows.Count, 1).End(xlUp).Row
r = Worksheets(“Sheet2”).Cells(Rows.Count, 3).End(xlUp).Row

Sheets(“Sheet1”).Select
    Set aa = Range(Cells(2, 2), Cells(e, 2))
    Set ab = Range(Cells(2, 4), Cells(e, 4))

Sheets(“Sheet2”).Select
    Set ba = Range(Cells(2, 1), Cells(r, 1))
    Set bb = Range(Cells(2, 5), Cells(r, 5))

For i = 0 To myDic.Count – 1
    a = WorksheetFunction.SumIf(aa, myKey(i), ab)
    b = WorksheetFunction.SumIf(ba, myKey(i), bb)

    If a <> b Then

        g = Worksheets(“Sheet3”).Cells(Rows.Count, 1).End(xlUp).Row
        h = Worksheets(“Sheet3”).Cells(Rows.Count, 5).End(xlUp).Row
        j = Application.WorksheetFunction.Max(g, h)

        Rows(“1:1”).AutoFilter 2, myKey(i)
        If WorksheetFunction.CountIf(ActiveSheet.Range(Cells(1, 2), Cells(e, 2)), myKey(i)) > 0 Then
            Range(Cells(2, 1), Cells(e, 4)).Copy Sheets(“Sheet3”).Cells(j + 1, 1)
        End If
        Selection.AutoFilter

       Rows(“1:1”).AutoFilter 1, myKey(i)
       If WorksheetFunction.CountIf(ActiveSheet.Range(Cells(1, 1), Cells(r, 1)), myKey(i)) > 0 Then
            Range(Cells(2, 1), Cells(r, 1)).Copy Sheets(“Sheet3”).Cells(j + 1, 6)
            Range(Cells(2, 2), Cells(r, 2)).Copy Sheets(“Sheet3”).Cells(j + 1, 5)
            Range(Cells(2, 4), Cells(r, 5)).Copy Sheets(“Sheet3”).Cells(j + 1, 7)
        End If
    End If
Next i

Set myDic = Nothing

g = Worksheets(“Sheet3”).Cells(Rows.Count, 1).End(xlUp).Row
h = Worksheets(“Sheet3”).Cells(Rows.Count, 5).End(xlUp).Row
j = Application.WorksheetFunction.Max(g, h)

Sheets(“Sheet3”).Select
Cells(1, 9).Copy
Range(Cells(2, 9), Cells(j, 9)).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Range(“A1”).Select

End Sub

解説

Sheet1のB列において、重複の無い伝票番号リストを作成し辞書に格納する

Sheet2のA列の中で、辞書の中に無いリストを、重複の無いように辞書に追加で格納する

辞書からリストを出力する

Sheet1(売上データ)の最終行を取得する
Sheet2(入金データ)の最終行を取得する

Sheet1の
伝票番号列(データ範囲)を取得する
金額列(データ範囲)を取得する

Sheet2の
伝票番号列(データ範囲)を取得する
金額列(データ範囲)を取得する

辞書に格納した全てのリストについて順に検証する

a=Sheet1の伝票番号ごとの合計金額
b=Sheet2の伝票番号ごとの合計金額

aとbがイコールでない場合、Sheet3に転記する
※Sheet3の1行目はタイトル。次からは同じ伝票番号が横並びになる

A列~D列:売上データを転記
E列~H列:入金データを転記
↑項目の順番を売上データに合わせる

A列の最終行とE列の最終行を比較して、大きい方をシート全体の最終行とする

Sheet1の1行目にオートフィルタを設定し、B列内でリストと一致するものを抽出する
抽出結果が0でなかった場合、A列~D列をコピーしてSheet3のA列,最終行+1行に貼り付ける
オートフィルタを解除

Sheet2の1行目にオートフィルタを設定し、A列内でリストと一致するものを抽出する
抽出結果が0でなかった場合、A列~E列(C列除く)をコピーしてSheet3のA列,最終行+1行に貼り付ける
オートフィルタを解除

辞書を空にする

Sheet3の最終行を取得する

あらかじめ、Sheet3のCell(1,9)に売上データと入金データの差額を計算する式を入れておく
=D1-H1
=offset(I1,0,-5)-offset(I1,0,-1) など
offsetを使うことでセルの削除や追加、移動などに対応可能
Cell(1,9)をコピーし、データ範囲に貼り付ける

この記事が気に入ったら
フォローしてね!

よかったらシェアしてね!

この記事を書いた人

子育てに奮闘しながらも、再びガッツリ走り込める日を夢見るフルタイム会社員。

コメント

コメントする

CAPTCHA


目次
閉じる