QA@IT

EXCELファイル複製時に、各シートの指定したセルに、年月日の更新を行いたい

3394 PV

EXCELのシートが12個あり、シート名が2月、3月、4月、5月、6月、7月、8月、9月、10月、11月、12月、1月 となっています。
(2月がスタートで、1月が決算)
2月シートのC2セルに 期間 2013.2.1~2013.2.28 と入力しています。
3月シートのC2セルに 期間 2013.3.1~2013.3.31 と入力しています。
1月シートのC2セルに 期間 2014.1.1~2014.1.31 と入力しています。

下記の構文を使って、次年度のファイルの複製を行っていますが、
各シートのC2セル内の 期間を年度ごとに更新することは出来ますでしょうか?

Sub ボタン1_Click()

Dim fName As String, flg As Boolean, i As Integer, myNum
Dim FSO As Object

On Error Resume Next

fName = ThisWorkbook.Name
flg = False
For i = 1 To Len(fName)
If Mid(fName, i, 1) Like "[0-9]" Then
flg = True
myNum = myNum & Mid(fName, i, 1)
Else
If flg Then Exit For
End If
Next i

If myNum = "" Then Exit Sub

fName = Replace(fName, myNum, myNum + 1, 1, 1)

Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile ThisWorkbook.FullName, ThisWorkbook.Path & "\" & fName
Set FSO = Nothing

MsgBox "終了しました"

End Sub

現在使用しているファイルは2013年度分です。2月シートのC2セルには、 期間 2013.2.1~2013.2.28 と入力しています。
上記のファイルに、上記のマクロを用いて、次年度のファイルを複製する際に、2月シートのC2セルに 期間 2014.2.1~2014.2.28 
とさせたく思います。他の月も、2014からのスタートになります。
1月シートだけは西暦が変わるので、 期間 2015.1.1~2015.1.31としたく思います。

というふうに、期間を更新して、ファイルの複製を致したく思います。(C2セルの更新は出来ておりません)
また、うるう年の2月だと29日なる為、こちらも合わせてご教授下さい。

宜しくお願い申し上げます。

  • 前々からそうですがパッチ無視しないでくださいね。 -

回答

myNumから年は分かりますので
年まで確定したとこから各シートに値を設定するところまでです。

月はシート名を半角にしてValで数値を取得すればよいです。
DateSerialのところで1日の日付値を取得。1月だけ年を+1です。
DateAddのところで末日を取得しています。1日から1ヶ月後の前日で
どんな月でも末日が求められます。
最後にフォーマットしてセルに設定しています。
これを各シートに対し行えば希望の動きになると思います。

    Dim Yr As Integer
    Dim Mn As Integer
    Dim Sheet As Worksheet
    Dim dt1 As Date
    Dim dt2 As Date

    Yr = 2014

    For Each Sheet In ThisWorkbook.Sheets
        Mn = Val(StrConv(Sheet.Name, vbNarrow))
        If Mn = 1 Then
            dt1 = DateSerial(Yr + 1, Mn, 1)
        Else
            dt1 = DateSerial(Yr, Mn, 1)
        End If
        dt2 = DateAdd("d", -1, DateAdd("m", 1, dt1))
        Sheet.Range("C2") = Format(dt1, "yyyy.m.d") & "~" & Format(dt2, "yyyy.m.d")
    Next
編集 履歴 (1)

サンプルPrg.はないが、基本ブック名から年をとって、
Date関数あたりで文字生成するだけでよいような?

編集 履歴 (0)
ウォッチ

この質問への回答やコメントをメールでお知らせします。