スケジュール表作成(2)
下記のようなVBAを作成しました。
Workdayの計算より日付を持ってきています。
このソースがそのまま使えるものではありません。自分のメモです。
-------------------------------------------------------------
Private Sub Workbook_Open()
Sheets("START0").Activate
End Sub
-------------------------------------------------------------
Private Sub CommandButton1_Click()
Dim Sheet_name As String
Dim New_sheet_name As String
Dim Month_MMM As String
Dim Year_yyyy As String
Dim Year_yy As String
Dim TODAY_c As Date
Dim TODAY_mm As Integer
Dim START0, CALC As Object
Dim Workday(40) As String
Dim i, j, k As Integer
'***************************
' Worksheetの定義
Set START0 = ThisWorkbook.Worksheets("START0")
Set CALC = ThisWorkbook.Worksheets("CALC")
' シート名を取得 yyyy-mm
Sheets("START0").Activate
Sheet_name = "H" & Range("I8") & Range("J8") & "-" & Range("M8") & Range("N8")
'***************************
' 年月を取得
Month_MMM = Format(Range("G6"), "mmm")
Month_mm = Format(Range("G6"), "mm")
Year_yyyy = Format(Range("G6"), "yyyy")
Year_yy = Format(Range("G6"), "yy")
'**************************
' 2/2のシート作成
'**************************
' 2/2のシートをコピー
Sheets("ORG").Select
Sheets("ORG").Copy After:=Sheets(3)
Sheets("ORG (2)").Name = Sheet_name & "-(2)"
' 追加したシートの名前を取得
New_sheet_name = Worksheets(4).Name
' 変更箇所
With Worksheets(New_sheet_name)
.Range("S5") = START0.Range("I8")
.Range("T5") = START0.Range("J8")
.Range("V5") = START0.Range("M8")
.Range("W5") = START0.Range("N8")
.Range("C11") = START0.Range("G10")
.Range("C13") = START0.Range("G12")
.Range("Z5") = "2/2"
End With
'**************************
' 1/2のシート作成
'**************************
' 1/2のシートをコピー
Sheets("ORG").Select
Sheets("ORG").Copy After:=Sheets(3)
Sheets("ORG (2)").Name = Sheet_name & "-(1)"
' 追加したシートの名前を取得
New_sheet_name = Worksheets(4).Name
' 変更箇所
With Worksheets(New_sheet_name)
.Range("S5") = START0.Range("I8")
.Range("T5") = START0.Range("J8")
.Range("V5") = START0.Range("M8")
.Range("W5") = START0.Range("N8")
.Range("C11") = START0.Range("G10")
.Range("C13") = START0.Range("G12")
.Range("B21") = "hoge-BANK-" & Month_MMM & Year_yy
.Range("B22") = "BANK-" & Month_MMM & "-" & Year_yyyy
End With
'**************************
' Working day を求める
'**************************
' 来月を識別
TODAY_c = Range("G6")
TODAY_mm = Month(DateAdd("m", 1, TODAY_c))
ThisWorkbook.Worksheets("calc").Activate
i = 3
j = 1
k = CALC.Range("A65536").End(xlUp).Row
' 配列Workdayにddを取り込む
For i = 3 To CALC.Range("A65536").End(xlUp).Row
If CALC.Cells(i, 2) = TODAY_mm Then
Workday(j) = CALC.Cells(i, 5)
j = j + 1
End If
Next i
' 1/2にddを入れ込む
'*******************
Worksheets(4).Activate
i = 0
j = 1
k = 23
While i < 10
If Workday(j) <> "" Then
Worksheets(4).Cells(k, 2) = "hoge-BANK-DAY" & Format(Workday(j), "dd")
i = i + 1
j = j + 1
k = k + 1
Else
j = j + 1
End If
Wend
' 2/2にddを入れ込む
'*******************
Worksheets(5).Activate
i = 0
k = 21
While j < 32
If Workday(j) <> "" Then
Worksheets(5).Cells(k, 2) = "hoge-BANK-DAY" & Format(Workday(j), "dd")
i = i + 1
j = j + 1
k = k + 1
Else
j = j + 1
End If
Wend
Worksheets(4).Activate
End Sub
-------------------------------------------------------------
「VBA」カテゴリの記事
- エクセル VBA 範囲指定(2009.10.16)
- エクセル VBA プリンタを指定して印刷(2009.04.24)
- エクセル VBA ピポットテーブルを作成(2009.04.17)
- エクセル VBA ファイル・フォルダの存在確認(2009.04.16)
- Excel VBA Tips (1)(2009.04.15)
The comments to this entry are closed.
Comments