IT備忘録

下記のような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

-------------------------------------------------------------

←クリック一票