既に以前月次更新の回はやっていますが今回は定数(Const)などを使用してもう少しだけ上のものを作ってみましょう。
表の入力箇所を定数に入れる
まずは表の売上等を入力する箇所の始まりと終わりを定数に入れましょう。
そもそもこれは不変の数字になるのですが、この規模だとわざわざ入れる必要がない気もしますが、ちゃんとした命名をした定数を設置しておくと長いコードになった時も単純に数字が書いてあるのと定数が置いてあるのとでは可読性に大きく違いが出てきます。
Sub next_month()
Const startRow As Integer = 3 '入力箇所始まりRow
Const endRow As Integer = 33 '入力箇所終わりRow
Const startCol As Integer = 7 '入力箇所始まりColumn
Const endCol As Integer = 8 '入力箇所終わりColumn
End Sub
※画像のendColは9になってますが、やっぱり8でした…
シート名を変数に格納
これは前回やったシートをコピーした後にシート名を変更する為等に使用して行こうと思います。
まずはシート名をString型の変数に格納して日付に変換して翌月のシート名と翌月分のシートのCells(2,3)、Cells(3,3)の年と月に使用していこうかと思います。
Sub next_month()
Const startRow As Integer = 3 '入力箇所始まりRow
Const endRow As Integer = 33 '入力箇所終わりRow
Const startCol As Integer = 7 '入力箇所始まりColumn
Const endCol As Integer = 8 '入力箇所終わりColumn
Dim sheetname As String
Dim nextsheet As Date
sheetname = ActiveSheet.Name
ActiveSheet.Copy after:=ActiveSheet
nextsheet = DateAdd("m", 1, Replace(sheetname, ".", "/") & "/1")
ActiveSheet.Name = Year(nextsheet) & "." & Month(nextsheet)
Cells(2, 3).Value = Year(nextsheet)
Cells(3, 3).Value = Month(nextsheet)
End Sub
今回新たに出てきたReplaceとは文字列置き換えの関数です。
引数1に文字列を与えます。
引数2に置き換えの対象となる文字列を与えます。
引数3で対象の文字列を何の文字列に置き換えるのかを指定します。
これでシート名にある「2017.11」という文字列が「2017/11」という文字列に置き換わったわけですね。そこに「/1」を繋げる事により「2017/11/1」という日付を完成させているわけです。
必要最低限の計算式と書式設定は入れてあるのでこれで翌月のシートはほぼ完成しましたね。
ここまで出来たら最後に表と入力箇所をクリアして翌月作成完了のメッセージを表示させていきましょう。
後はボタンを作ればOKですかね。
一応前回からの入力と今回の翌月更新の全文を載せておきます。
Option Explicit
Sub next_month()
Const startRow As Integer = 3 '入力箇所始まりRow
Const endRow As Integer = 33 '入力箇所終わりRow
Const startCol As Integer = 7 '入力箇所始まりColumn
Const endCol As Integer = 8 '入力箇所終わりColumn
Dim sheetname As String '翌月更新前のシート名
Dim nextsheet As Date '翌月更新後のシートの日付
sheetname = ActiveSheet.Name
ActiveSheet.Copy after:=ActiveSheet
nextsheet = DateAdd("m", 1, Replace(sheetname, ".", "/") & "/1")
ActiveSheet.Name = Year(nextsheet) & "." & Month(nextsheet)
Cells(2, 3).Value = Year(nextsheet)
Cells(3, 3).Value = Month(nextsheet)
Range(Cells(startRow, startCol), Cells(endRow, endCol)).ClearContents
Range(Cells(2, 12), Cells(4, 12)).ClearContents
MsgBox "翌月作成完了"
End Sub
Sub input_sheet()
Const startRow As Integer = 2 '表の入力始まりRow
Const dateCol As Integer = 5 '表の日付Column
Const baseCol As Integer = 8 '表の売上Column
Dim i As Long 'カウンタ変数
Dim dates As Integer '日付
Dim stock As Long '仕入
Dim sales As Long '売上
'error trap -------------------------
If Cells(2, 12).Value = "" Or Not IsNumeric(Cells(2, 12).Value) Then
MsgBox "日付欄が空白、もしくは数値ではありません"
Exit Sub
End If
If Cells(4, 12).Value = "" Or Not IsNumeric(Cells(4, 12).Value) Then
MsgBox "売上欄が空白、もしくは数値ではありません"
Exit Sub
End If
'vaiable set ------------------------
dates = Cells(2, 12).Value
stock = Cells(3, 12).Value
sales = Cells(4, 12).Value
'row get and input ------------------
i = Cells(Rows.Count, dateCol).End(xlUp).Row
Do
If IsDate(Cells(i, dateCol)) And Not Cells(i, dateCol).Value Like "" Then
If CInt(Day(Cells(i, dateCol))) = dates Then
With Cells(i, baseCol)
.Value = sales
.Offset(0, -1).Value = stock
Exit Do
End With
End If
End If
i = i - 1
If i < startRow Then
MsgBox "対象の日付が見つかりませんでした"
Exit Sub
End If
Loop
MsgBox dates & "日の売上データ入力完了"
End Sub
という事で翌月作成が出来ました。
次回からは1次元の配列についてお勉強していこうかと思います。