合計金額から各金種数量を自動算出。金種数量表で表示

kinsyusaku2eyecatch

金種数量表を作成します。自動計算で金種数量を算出するコードの説明です。

同時に複数の相手先・項目の合計金額から、それぞれに金種数量を計算することが出来ます。

こんにちは、じゅんぱ店長（@junpa33）です。

今回は「金種表作成ソフト」の作成で、「金種・数量表示」を表示するためのVBAコードの組み立てを行っていきます。

シートで言うと、「金種数量」シートの部分の説明となります。

自動計算で金種数量表が作れるコードの作成です。

その前に、先回の記事をもう一度チェックするにはこちら↓になります。

kinsyusaku1eyecatch VBAでSUM関数を使い合計金額を計算する。金種表作成

金種数量表を新規に作成します

kinsyusuryoup035

まず、どのような金種数量表（一覧表）にするかを計画します。

  1. タテ列に相手先・項目を並べます。件数は制限を設定しない。
  2. ヨコ列には金種ごとの数量を配置します。
  3. 合計欄は最終行に、縦割りで金種ごとに合計します。

シート名を変更します。

Sheet2は「金種数量」、Sheet3は「印刷用」としてください。

目次へ戻る

金種数量表で自動計算を行うVBA

kinsyusuryoup036

作成する金種数量表はこのような感じです

kinsyu018a

VBAコードの作成

ここからのコードは、「Module2」に記述します。

モジュール内で利用する変数を宣言します

変数を宣言するコードです。モジュールの先頭に記述します。

vbasengeneyecatch 宣言方法で変数の適用範囲を変える エクセルVBA
VBA
Option Explicit

    Private SSheet, KSheet, ASheet As Worksheet

プロシージャー名「シートSet」で変数をセットします。

vbasheetvariableeyecatch ワークシートを変数化する3つの手法 オブジェクト変数など
VBA
Sub シートset()
        Set SSheet = Worksheets("設定")
        Set KSheet = Worksheets("金種数量")
        Set ASheet = Worksheets("印刷用")
End Sub

シートの初期化のコードを記述します

vbacleareyecatch シートクリアーを目的のメソッド別にVBA最速理解
VBA
Sub シートクリア()
        With Cells
            .ClearFormats
            .ClearContents
            .UseStandardHeight = True
            .UseStandardWidth = True
        End With
End Sub

コード本体のプロシージャー名は「金種数量」とします

最初に「金種数量」シートを初期化して始めます。 ここのコードは、作表の中のセルの幅・高さ、フォントサイズやカラーなどを規定しています。

vbacalleyecatch 部品化プロシージャーでCallステートメントは必須 vbalastcelleyecatch データ入力済セルの最終行番号を取得する fornextirekoeyecatch For～Nextのループと入れ子構造をVBA最速理解 vbawithstateeyecatch With～End Withの使い方。VBAコードを簡潔に記述する vbacellsfonteyecatch 「フォント」の操作を最速理解する エクセルVBA
VBA
Sub 金種数量()
    Dim Arow, Brow, Bcol As Long
    Dim n, s, p, r, t As Long
    Dim V, Va, Vb, Vc, Vd, Ve, Vf, Vg, Vh, Vi As Variant
'「金種数量」シートの初期化
        Call Module2.シートset
        KSheet.Select
        Call Module2.シートクリア
        Arow = SSheet.Cells(Rows.Count, 1).End(xlUp).Row
        For n = 3 To Arow
            With SSheet
                KSheet.Range("A" & n) = .Range("A" & n)
                KSheet.Range("B" & n) = .Range("B" & n)
            End With
        Next n
        With KSheet
            .Range("A" & Arow + 1) = "合計"
            .Range("B1") = Now
            .Rows.RowHeight = 21
            .Range("A:A").Columns.ColumnWidth = 15
            .Range("B:B").Columns.ColumnWidth = 13
            .Range("C:L").Columns.ColumnWidth = 10
            .Rows(1).RowHeight = 35
            .Rows(2).RowHeight = 35
            .Cells.Font.Size = 15
            .Cells.Font.Bold = True
            .Rows(1).Font.Size = 13
            .Range("B1").Font.Size = 9
            Brow = .Cells(Rows.Count, 1).End(xlUp).Row
            .Range("B3", "B" & Brow).NumberFormatLocal = _
                        "\#,##0;\-#,##0"
            .Range("C1", "L" & Brow).ClearContents

次に金種名を表示しますが、 問題となる部分は、２０００円を利用する場合としない場合があるということです。

先回解説の「２０００円チェックボックス」の部分で説明いたしました様に、 「設定」シートのＢ１セルに「〇」が有るか無いかで「２０００円」を使いかどうかを判定することが出来ます。

そこで、条件分岐で「〇」の場合「＋１」、「　」の場合「０」の値をセットします。

vbaifjyokeneyecatch If条件文のVBAコードの組み方。条件の絞り方を最速理解 vbacellssyoshikieyecatch 「表示形式」をVBAコード的に最速理解する vbacellspaintbackeyecatch 「塗りつぶし」背景色をVBAで記述する
VBA
'「2000円札使用」の判定
            p = 0
            .Cells(1, 3) = 10000
            .Cells(1, 4) = 5000
            If SSheet.Range("B1") = "〇" Then
                p = 1
                .Cells(1, 5) = 2000
            ElseIf SSheet.Range("B1") = "" Then
                p = 0
            End If
            .Cells(1, 5 + p) = 1000
            .Cells(1, 6 + p) = 500
            .Cells(1, 7 + p) = 100
            .Cells(1, 8 + p) = 50
            .Cells(1, 9 + p) = 10
            .Cells(1, 10 + p) = 5
            .Cells(1, 11 + p) = 1
            .Range("C1:L1").NumberFormatLocal = "#,##0円"
            .Range("A1", "L2").HorizontalAlignment = _
                        xlCenter
        End With
        KSheet.Select
        For s = 3 To Brow Step 2
            With Range(Cells(s, 1), Cells(s, 11 + p))
                .Interior.ColorIndex = 20
            End With
        Next s
        Range(Cells(Brow, 1), Cells(Brow, 11 + p)). _
                    Interior.ColorIndex = 6
        For r = 1 To 12
            If r = 1 Then
                Cells(2, r) = "相手先・項目"
            ElseIf r = 2 Then
                Cells(2, r) = "金額"
            Else
                Cells(2, r) = "数量"
                If Cells(1, 12) = "" Then
                    Cells(2, 12) = ""
                End If
            End If
        Next r

金種ごとの枚数計算を行うコードです。

２０００円を使いか使わないかの差は、Ｋ列が「金種１円か５円か」で判定します。

２０００円を使う場合はＫ列が「５円」となります。

表の最終行に、「SUM関数」を利用して各タテ列の合計を集計表示します。

vbasumeyecatch SUM関数で合計計算！実務で使えるVBAコード作成 vbaentirecolumneyecatch EntireColumnとColumnの使い方
VBA
        KSheet.Select
        For s = 3 To Brow - 1
            V = Range("B" & s).Value
            Range("C" & s) = V \ 10000
            Va = V Mod 10000
            Range("D" & s) = Va \ 5000
            Vb = V Mod 5000
            Range("E" & s) = Vb \ Range("E1")
            Vc = Vb Mod Range("E1")
            Range("F" & s) = Vc \ Range("F1")
            Vd = Vc Mod Range("F1")
            Range("G" & s) = Vd \ Range("G1")
            Ve = Vd Mod Range("G1")
            Range("H" & s) = Ve \ Range("H1")
            Vf = Ve Mod Range("H1")
            Range("I" & s) = Vf \ Range("I1")
            Vg = Vf Mod Range("I1")
            Range("J" & s) = Vg \ Range("J1")
            Vh = Vg Mod Range("J1")
'K列の金種判定
            If Range("K1") = 5 Then
                Range("K" & s) = Vh \ Range("K1")
                Vi = Vh Mod Range("K1")
                Range("L" & s) = Vi
            ElseIf Range("K1") = 1 Then
                Range("K" & s) = Vh
            End If
        Next s
        Bcol = Cells(1, Columns.Count).End(xlToLeft).Column
        For t = 2 To Bcol
            Cells(Brow, t) = WorksheetFunction. _
                    Sum(Range(Cells(3, t), Cells(Brow - 1, t)))
        Next t
End Sub
目次へ戻る

ここまでのまとめ

kinsyusuryoup037

Module2に記述したコードは全体を通してこのようになります。

VBA
Option Explicit

    Private SSheet, KSheet, ASheet As Worksheet

Sub シートset()
        Set SSheet = Worksheets("設定")
        Set KSheet = Worksheets("金種数量")
        Set ASheet = Worksheets("印刷用")
End Sub

Sub シートクリア()
        KSheet.Select
        With Cells
            .ClearFormats
            .ClearContents
            .UseStandardHeight = True
            .UseStandardWidth = True
        End With
End Sub

Sub 金種数量()
    Dim Arow, Brow, Bcol As Long
    Dim n, s, p, r, t As Long
    Dim V, Va, Vb, Vc, Vd, Ve, Vf, Vg, Vh, Vi As Variant
'「金種数量」シートの初期化
        Call Module2.シートset
        Call Module2.シートクリア
        Arow = SSheet.Cells(Rows.Count, 1).End(xlUp).Row
        For n = 3 To Arow
            With SSheet
                KSheet.Range("A" & n) = .Range("A" & n)
                KSheet.Range("B" & n) = .Range("B" & n)
            End With
        Next n
        With KSheet
            .Range("A" & Arow + 1) = "合計"
            .Range("B1") = Now
            .Rows.RowHeight = 21
            .Range("A:A").Columns.ColumnWidth = 15
            .Range("B:B").Columns.ColumnWidth = 13
            .Range("C:L").Columns.ColumnWidth = 10
            .Rows(1).RowHeight = 35
            .Rows(2).RowHeight = 35
            .Cells.Font.Size = 15
            .Cells.Font.Bold = True
            .Rows(1).Font.Size = 13
            .Range("B1").Font.Size = 9
            Brow = .Cells(Rows.Count, 1).End(xlUp).Row
            .Range("B3", "B" & Brow).NumberFormatLocal = _
                        "\#,##0;\-#,##0"
            .Range("C1", "L" & Brow).ClearContents
'「2000円札使用」の判定
            p = 0
            .Cells(1, 3) = 10000
            .Cells(1, 4) = 5000
            If SSheet.Range("B1") = "〇" Then
                p = 1
                .Cells(1, 5) = 2000
            ElseIf SSheet.Range("B1") = "" Then
                p = 0
            End If
            .Cells(1, 5 + p) = 1000
            .Cells(1, 6 + p) = 500
            .Cells(1, 7 + p) = 100
            .Cells(1, 8 + p) = 50
            .Cells(1, 9 + p) = 10
            .Cells(1, 10 + p) = 5
            .Cells(1, 11 + p) = 1
            .Range("C1:L1").NumberFormatLocal = "#,##0円"
            .Range("A1", "L2").HorizontalAlignment = _
                        xlCenter
        End With
        KSheet.Select
        For s = 3 To Brow Step 2
            With Range(Cells(s, 1), Cells(s, 11 + p))
                .Interior.ColorIndex = 20
            End With
        Next s
        Range(Cells(Brow, 1), Cells(Brow, 11 + p)). _
                    Interior.ColorIndex = 6
        For r = 1 To 12
            If r = 1 Then
                Cells(2, r) = "相手先・項目"
            ElseIf r = 2 Then
                Cells(2, r) = "金額"
            Else
                Cells(2, r) = "数量"
                If Cells(1, 12) = "" Then
                    Cells(2, 12) = ""
                End If
            End If
        Next r
        KSheet.Select
        For s = 3 To Brow - 1
            V = Range("B" & s).Value
            Range("C" & s) = V \ 10000
            Va = V Mod 10000
            Range("D" & s) = Va \ 5000
            Vb = V Mod 5000
            Range("E" & s) = Vb \ Range("E1")
            Vc = Vb Mod Range("E1")
            Range("F" & s) = Vc \ Range("F1")
            Vd = Vc Mod Range("F1")
            Range("G" & s) = Vd \ Range("G1")
            Ve = Vd Mod Range("G1")
            Range("H" & s) = Ve \ Range("H1")
            Vf = Ve Mod Range("H1")
            Range("I" & s) = Vf \ Range("I1")
            Vg = Vf Mod Range("I1")
            Range("J" & s) = Vg \ Range("J1")
            Vh = Vg Mod Range("J1")
'K列の金種判定
            If Range("K1") = 5 Then
                Range("K" & s) = Vh \ Range("K1")
                Vi = Vh Mod Range("K1")
                Range("L" & s) = Vi
            ElseIf Range("K1") = 1 Then
                Range("K" & s) = Vh
            End If
        Next s
        Bcol = Cells(1, Columns.Count).End(xlToLeft).Column
        For t = 2 To Bcol
            Cells(Brow, t) = WorksheetFunction. _
                    Sum(Range(Cells(3, t), Cells(Brow - 1, t)))
        Next t
End Sub

これで、合計金額からどの金種がどれだけ必要かを、いちいち電卓を使って計算しなくても自動計算できるようになりました。

特に、複数の相手先がある場合には、効果絶大だと思います。

全体で準備する金種も合計欄の数量でＯＫということになります。

一応これで、VBAソフト作成の目的達成になりますが、

金種表の紙データを出力できるようにもしておきます。

（実際、紙化して保存という場合もまだまだ多いと思います。）

次回の記事で紹介させていただきます。

次回の記事に進むにはこちら↓になります。

kinsyusaku3eyecatch 作成した金種表を印刷するVBA。相手先と合計別

エクセルVBAを独習するのに参考書は欠かせません。 参考書選びは自分に合った「相棒」にできるものを選んでいきたいです。

vbastudyeyecatch2 エクセルVBAの独習でおすすめ参考書を7冊選ぶ。良書との出会いは大切です

今回の記事はここまでです。   最後までご覧いただき有難うございました。

エクセルVBA最速理解で必要な知識を集めよう！

エクセルVBA業務ツールで日常の業務改善を行いましょう。

＜記事内容についての告知＞

VBAコードの記述記事においては、その記述には細心の注意をしたつもりですが、掲載のVBAコードは動作を保証するものではりません。 あくまでVBAの情報の一例として掲載しています。 掲載のVBAコードのご使用は、自己責任でご判断ください。 万一データ破損等の損害が発生しても当方では責任は負いません。

目次へ戻る

アンケートでポイ活しよう!!

アンケートに答えれば答えるほど ”使える” ポイントがたまります。

NTTコム サーチ

af_banner01

Dstyle web

dstyleweb_logo
dstyle_320x50-min

前の記事

kinsyusaku1eyecatch
VBAでSUM関数を使い合計金額を計算する。金種表作成

次の記事

作成した金種表を印刷するVBA。相手先と合計別
kinsyusaku3eyecatch