QA@IT

Excelファイルでのシートを指定しての期間更新について

1496 PV

お世話になります
Excelファイルを複製して、各シートのセル(C2)に表示している期間を、年度毎に更新させます

使用するファイル:A1ファイル

A1ファイルで複製すると、A2ファイルになります
A2ファイルで複製すると、A3ファイルになります

A1ファイルには、2、3、4、5、6、7、8、9、10、11、12、1シートがあります
上記のシートのC2セルには、以下のように表示されております
2シートのC2セル     :期 間  2013.1.26~2013.2.25

3シートのC2セル     :期 間  2013.2.26~2013.3.25

4シートのC2セル     :期 間  2013.3.26~2013.4.25

5シートのC2セル     :期 間  2013.4.26~2013.5.25

6シートのC2セル     :期 間  2013.5.26~2013.6.25

7シートのC2セル     :期 間  2013.6.26~2013.7.25

8シートのC2セル     :期 間  2013.7.26~2013.8.25

9シートのC2セル     :期 間  2013.8.26~2013.9.25

10シートのC2セル :期 間  2013.9.26~2013.10.25
10(2)シートのC2セル :期 間  2013.10.26~2013.10.31
11シートのC2セル :期 間  2013.11.1~2013.11.25

12シートのC2セル :期 間  2013.11.26~2013.12.25

1シートのC2セル :期 間  2013.12.26~2014.1.25

A1ファイルで複製すると、A2ファイルになります
A2ファイルには、各シートが存在します

2シートのC2セル     :期 間  2014.1.26~2014.2.25

3シートのC2セル     :期 間  2014.2.26~2014.3.25

4シートのC2セル     :期 間  2014.3.26~2014.4.25

5シートのC2セル     :期 間  2014.4.26~2014.5.25

6シートのC2セル     :期 間  2014.5.26~2014.6.25

7シートのC2セル     :期 間  2014.6.26~2014.7.25

8シートのC2セル     :期 間  2014.7.26~2014.8.25

9シートのC2セル     :期 間  2014.8.26~2014.9.25

10シートのC2セル :期 間  2014.9.26~2014.10.25
10(2)シートのC2セル :期 間  2014.10.26~2014.11.25 ※ 
11シートのC2セル :期 間  2014.11.26~2014.12.25 ※  
12シートのC2セル :期 間  2014.12.26~2015.1.25  ※

1シートのC2セル :期 間  2015.1.26~2015.2.25  ※

という状態になります

※の期間が、25日締の期間になってしまっております

10(2)シート、11シート、12シート、1シートのC2セルだけ期間を指定(A1ファイルの期間を踏襲し、年度を更新)し
2シートから10シートの期間(25日締)と異なるように更新致したく思いますがご教授いただけないでしょうか?
以下、コードになります

Sub ボタン2_Click()
Dim fName As String, flg As Boolean, i As Integer, myNum
Dim FSO As Object, wb As Workbook, ws As Worksheet
Dim stDate As Date, edDate As Date
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
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & fName)
stDate = DateValue(Left(fName, 1) & myNum + 1 & "/1/26")
For Each ws In wb.Worksheets
edDate = DateSerial(year(stDate), Month(stDate) + 1, 25)
ws.Range("C2").Value = "期間 " & Format(stDate, "yyyy.m.d") & _
"~" & Format(edDate, "yyyy.m.d")
stDate = DateSerial(year(stDate), Month(stDate) + 1, 26)
Next ws
wb.Close True
End Sub

宜しくお願い致します

ウォッチ

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