月次更新②

既に以前月次更新の回はやっていますが今回は定数(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次元の配列についてお勉強していこうかと思います。

<<シートに値を入力  1次元配列>>

スポンサーリンク

シェアする

フォローする