【VBA初心者】契約内容の分類を自動化！毎月の仕分け作業をラクにする

小売業で働くYasuと申します。スーパー銭湯♨大好きで、最近はボートレースにもはまりつつあります。

私が担当している業務に、「リベートの管理」 というものがあります。「リベートとは何ぞや？」と思われた方も多くいらっしゃることかと思います。

小売業でいうリベート（割り戻し金）とは、お取引先が取引高や目標達成度に応じて、われわれ小売業者に対して代金を払い戻す仕組みのことを指します。簡単に言えば、「おたくの商品たくさん売るんで、目標達成したらお金くださいね。お互い、Win-Winでいきましょう」みたいな感じです。

前回の記事では、リベート管理業務の一つである請求書発送作業を、GASを活用して自動化した事例をご紹介しています。ご興味のある方は、ぜひあわせてご覧ください。

リベート実績の管理表を一元化したい！

現在も管理表は運用していますが、3つのファイルに分かれているため全体像を把握しづらく、作成や更新にも多くの時間がかかっています

現在の管理表と作成フロー

ファイル①リベート管理報告書

【強み】グループ別、取引先別、月度別の実績が確認可能。ドリルダウンで取引先別の契約詳細も確認可能。
【弱み】四半期別、半期別の累計は確認できない。詳細な昨年との比較ができない。

ファイル②リベートG別メーカー別昨差表

【強み】グループ別に、月度別・半期・年間で 取引先別の実績が確認可能。
【弱み】昨年比較ができない。

ファイル③YYMM_実績抽出_部門名

【強み】項目別（6項目）にリベートの詳細実績が確認可能。
【弱み】昨年比較ができない。

現在もAccessを活用した業務の自動化は進めていますが、管理表がファイル①・②・③の3つに分かれている状況です。それぞれにメリットと課題があるため、情報を一元管理できる新たな管理表の作成に取り組んでいます。

今回の記事では、その取り組みの途中経過についてご紹介します。

新管理表作成に向けてやるべきこと

①契約内容を 6項目に自動分類

ファイル③でも紹介したとおり、リベートは契約内容に応じて6つの項目に分類して管理しています。現在は手作業で分類しているため、この工程を自動化することにしました。

② 実績比較表を自動作成

部門別・メーカー別に、本年実績、昨年実績、昨年差を確認できる一覧表を、元データから自動で作成できるようにします。

③ 詳細実績をポップアップ表示

②で作成した一覧表のセルをクリックすると、6つの項目ごとに本年実績と昨年実績を比較できる詳細表がポップアップで表示されるようにします。
【成果物の完成イメージ図】

契約内容を6項目に自動分類

項目ごとの説明は長くなるので割愛しますが、下記6つに分類して管理しています。
①入金計上 ②相殺計上 ③入金戻し ④未収戻し ⑤未収計上（システム） ⑥未収計上（紙）
このうち、①・③・⑤・⑥は複数の条件を組み合わせて判定する必要があるため、自動化することにしました。

VBAで実現した動作

【指定している条件】
条件①：I列に「入金」と記載されており、かつJ列の数字が「０」以外の場合、M列に「①入金計上」と記入する。
条件②：I列に「相殺」と記載されており、かつJ列の数字が「０」以外の場合、M列に「②相殺計上」と記入する。
条件③：K列の数字が「-1」以下の場合、N列に「③入金戻し」と記入する。
条件④：K列の数字が「1」以上の場合、N列に「⑤未収計上（システム）」と記入する。

VBAのコードはこちらをクリック

Sub M列N列に判定結果を記入()

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim nyukinKubun As String
    Dim kingakuJ As Double
    Dim kingakuK As Double

    Set ws = ActiveSheet

    '最終行をI列基準で取得
    lastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row

    '3行目から最終行まで処理
    For i = 3 To lastRow

        nyukinKubun = Trim(ws.Cells(i, "I").Value)

        'J列の数値取得
        If IsNumeric(ws.Cells(i, "J").Value) Then
            kingakuJ = CDbl(ws.Cells(i, "J").Value)
        Else
            kingakuJ = 0
        End If

        'K列の数値取得
        If IsNumeric(ws.Cells(i, "K").Value) Then
            kingakuK = CDbl(ws.Cells(i, "K").Value)
        Else
            kingakuK = 0
        End If

        'M列・N列を初期化
        ws.Cells(i, "M").Value = ""
        ws.Cells(i, "N").Value = ""

        '=========================
        ' M列の判定
        '=========================
        If nyukinKubun = "入金" And kingakuJ <> 0 Then
            ws.Cells(i, "M").Value = "①入金計上"

        ElseIf nyukinKubun = "相殺" And kingakuJ <> 0 Then
            ws.Cells(i, "M").Value = "②相殺計上"
        End If

        '=========================
        ' N列の判定
        '=========================
        If kingakuK <= -1 Then
            ws.Cells(i, "N").Value = "③入金戻し"

        ElseIf kingakuK >= 1 Then
            ws.Cells(i, "N").Value = "⑤未収計上（システム）"
        End If

    Next i

    MsgBox "M列・N列への判定入力が完了しました。"

End Sub

今回の記事は、ここまでとなります。今のところは大きなトラブルもなく順調に進んでいますが、本当の勝負はここからです。引き続き、やるべきこと②・③に取り組み、結果を記事にしていきたいと思います。 最後までお読みいただき、ありがとうございました。