金種数量表を作成します。自動計算で金種数量を算出するコードの説明です。
同時に複数の相手先・項目の合計金額から、それぞれに金種数量を計算することが出来ます。
こんにちは、じゅんぱ店長(@junpa33)です。
今回は「金種表作成ソフト」の作成で、「金種・数量表示」を表示するためのVBAコードの組み立てを行っていきます。
シートで言うと、「金種数量」シートの部分の説明となります。
自動計算で金種数量表が作れるコードの作成です。
その前に、先回の記事をもう一度チェックするにはこちら↓になります。

金種表作成ソフトの記事編成
- 金種表作成ソフトの使い方とダウンロード
コンテンツ
金種数量表を新規に作成します

まず、どのような金種数量表(一覧表)にするかを計画します。
- タテ列に相手先・項目を並べます。件数は制限を設定しない。
- ヨコ列には金種ごとの数量を配置します。
- 合計欄は最終行に、縦割りで金種ごとに合計します。
シート名を変更します。
Sheet2は「金種数量」、Sheet3は「印刷用」としてください。
金種数量表で自動計算を行うVBA

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

VBAコードの作成
ここからのコードは、「Module2」に記述します。
変数を宣言するコードです。モジュールの先頭に記述します。

Option Explicit
Private SSheet, KSheet, ASheet As Worksheet
プロシージャー名「シートSet」で変数をセットします。

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

Sub シートクリア()
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
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
次に金種名を表示しますが、 問題となる部分は、2000円を利用する場合としない場合があるということです。
先回解説の「2000円チェックボックス」の部分で説明いたしました様に、 「設定」シートのB1セルに「〇」が有るか無いかで「2000円」を使いかどうかを判定することが出来ます。
そこで、条件分岐で「〇」の場合「+1」、「 」の場合「0」の値をセットします。



'「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
金種ごとの枚数計算を行うコードです。
2000円を使いか使わないかの差は、K列が「金種1円か5円か」で判定します。
2000円を使う場合はK列が「5円」となります。
表の最終行に、「SUM関数」を利用して各タテ列の合計を集計表示します。


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
ここまでのまとめ

Module2に記述したコードは全体を通してこのようになります。
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
これで、合計金額からどの金種がどれだけ必要かを、いちいち電卓を使って計算しなくても自動計算できるようになりました。
特に、複数の相手先がある場合には、効果絶大だと思います。
全体で準備する金種も合計欄の数量でOKということになります。
一応これで、VBAソフト作成の目的達成になりますが、
金種表の紙データを出力できるようにもしておきます。
(実際、紙化して保存という場合もまだまだ多いと思います。)
次回の記事で紹介させていただきます。
次回の記事に進むにはこちら↓になります。

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

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