WBS作成用マクロ（個人用メモ）

エクセルWBSの予定開始終了日を入れるマクロ

現場向けメモ

準備

• タスク(1行)ごとに以下の列を用意。工数を入れておくこと。

1. 担当
2. 工数
3. 開始日
4. 終了日（バッファ込み）
5. 実質終了日（バッファなし）

メモ

• マクロの挙動：担当者1名ごとに予定日を入れていく。
  　⇒　担当者ごとにタスク開始日が異なったり、他のタスクとの並行によって微調整が必要な場合があるため、担当者を絞る。

WBSサンプル

%%tab%%をタブに置換

タスク名%%tab%%担当%%tab%%順番%%tab%%工数%%tab%%開始日%%tab%%終了日%%tab%%実質終了日
task1-3%%tab%%XX%%tab%%3%%tab%%1%%tab%%%%tab%%%%tab%%
task1-2%%tab%%XX%%tab%%2%%tab%%0.5%%tab%%%%tab%%%%tab%%
task1-1%%tab%%XX%%tab%%1%%tab%%1.5%%tab%%%%tab%%%%tab%%
task2-1%%tab%%YY%%tab%%1%%tab%%2%%tab%%%%tab%%%%tab%%
task2-2%%tab%%YY%%tab%%2%%tab%%3%%tab%%%%tab%%%%tab%%
task1-4%%tab%%XX%%tab%%4%%tab%%3%%tab%%%%tab%%%%tab%%

コード

'各列定義
Const COL_TASK As Integer = 1
Const COL_TANTOU As Integer = 2
Const COL_ORDER As Integer = 3
Const COL_KOSU As Integer = 4
Const COL_DATE_START As Integer = 5
Const COL_DATE_END As Integer = 6
Const COL_DATE_END_REAL As Integer = 7

'タスク記載開始行
Const ROW_START As Integer = 1

'バッファ日数
Const BUFFER_DATE As Integer = 1

'対象担当者
Const TARGET_TANTOU As String = "XX"



Sub createWBS()
    'タスク開始日
    Dim taskStartDate As Date
    taskStartDate = CDate("2024/10/1")
    
    '祝日
    Dim rangeHoliday As Range
    Set rangeHoliday = Range("H1")
    
    '終了行
    Dim rowEnd
    rowEnd = Cells(ROW_START, COL_KOSU).End(xlDown).Row
    
    
    '対象タスクの各種情報を格納するリスト
    Dim kosuList()     '工数
    Dim taskList()     'タスク名
    Dim rowList()      '行数
        
    '対象タスク数を取得しサイズを定義
    cnt = Application.WorksheetFunction.CountIf(Range(Cells(ROW_START, COL_TANTOU).Address, Cells(rowEnd, COL_TANTOU).Address), TARGET_TANTOU)
    ReDim kosuList(cnt - 1)
    ReDim taskList(cnt - 1)
    ReDim rowList(cnt - 1)
    
    '-----------------------------
    '対象タスクの各種情報リスト作成
    '-----------------------------
    For rw = ROW_START To rowEnd
        If Cells(rw, COL_TANTOU).Value = TARGET_TANTOU Then
            Dim index
            index = Cells(rw, COL_ORDER).Value - 1        'タスクの順番にしたがって格納する
            kosuList(index) = Cells(rw, COL_KOSU).Value
            taskList(index) = Cells(rw, COL_TASK).Value
            rowList(index) = rw
        End If
        
    Next rw
    
    
'    For i = 0 To cnt - 1
'        Debug.Print (taskList(i) & "　:　" & kosuList(i) & "人日　:　" & rowList(i) & "行目")
'    Next i
   
    
    
    '-----------------------------
    '予定日取得 ⇒　計算してそのままセルに反映
    '-----------------------------
    Dim startDateList()
    Dim endDateList()
    Dim endDateRealList()
    ReDim startDateList(cnt - 1)
    ReDim endDateList(cnt - 1)
    ReDim endDateRealList(cnt - 1)
    
    For i = 0 To cnt - 1
'        '開始日
'        If i = 0 Then
'            startDateList(i) = taskStartDate
'        Else
'            startDateList(i) = Application.WorksheetFunction.WorkDay_Intl(endDateRealList(i - 1), 1, 1, rangeHoliday)
'        End If
'
'        '終了日（バッファなし）
'        endDateRealList(i) = Application.WorksheetFunction.WorkDay_Intl(startDateList(i), WorksheetFunction.Ceiling_Math(kosuList(i), 1) - 1, 1, rangeHoliday)
'
'        '終了日（バッファ込み）
'        endDateList(i) = Application.WorksheetFunction.WorkDay_Intl(endDateRealList(i), BUFFER_DATE, 1, rangeHoliday)
'
   
        
        'セルに反映
        Dim tmp_s, tmp_er
        If i = 0 Then
            tmp_s = taskStartDate
        Else
            tmp_s = Application.WorksheetFunction.WorkDay_Intl(Cells(rowList(i - 1), COL_DATE_END_REAL), 1, 1, rangeHoliday)
        End If
        tmp_er = Application.WorksheetFunction.WorkDay_Intl(tmp_s, WorksheetFunction.Ceiling_Math(kosuList(i), 1) - 1, 1, rangeHoliday)
        
        '開始日
        Cells(rowList(i), COL_DATE_START) = tmp_s
        '終了日（バッファなし）
        Cells(rowList(i), COL_DATE_END_REAL) = tmp_er
        '終了日（バッファ込み
        Cells(rowList(i), COL_DATE_END) = Application.WorksheetFunction.WorkDay_Intl(tmp_er, BUFFER_DATE, 1, rangeHoliday)

        

    Next i
       
End Sub