Option Explicit
Option Base 1
'-----------------------------------------------
' プロシージャ名 : exec工数算出
' 機能概要 : ガントシートを走査し、工数データを営業日数込みで収集する
' 留意点 : 担当者が未入力の行や日付不整合はスキップ／終了する
'-----------------------------------------------
Public Sub exec工数算出()
Dim wsガント As Worksheet
Dim lngRowEnd As Long
Dim lngRow As Long
Dim lng工程Idx As Long
Dim lngCol担当 As Long
Dim lng開始日列 As Long, lng終了日列 As Long
Dim lng工数列 As Long
Dim cls工数データ As cls工数データ
Dim clt工程一覧 As Collection
Dim dic休業日 As Scripting.Dictionary
Dim typ列情報 As typガント列定義
Dim dat処理開始 As Date, dat処理終了 As Date
Dim dic集計レコード As Scripting.Dictionary
On Error GoTo ERR_HANDLER
dat処理開始 = Now
' 必須シートの存在確認
If Not fncBlnシート存在確認() Then Exit Sub
' シート取得
Set wsガント = ThisWorkbook.Worksheets(STR_WSNAME_ガント)
' 列定義初期化
typ列情報 = fncガント列定義取得()
' 工数の数値形式チェック（数値以外があれば終了）
If Not fncBlnCheck工数値(wsガント, typ列情報) Then Exit Sub
Set clt工程一覧 = New Collection
Set dic休業日 = fnc休業日Dictionary取得()
With wsガント
lngRowEnd = .Cells(.Rows.Count, typ列情報.ツール名).End(xlUp).Row
For lng工程Idx = C_LNG_工程START To C_INT_工程END
' 列名を列番号に変換
Call prc列番号変換(typ列情報, lng工程Idx, lng工数列, lngCol担当, lng開始日列, lng終了日列)
' ガントチャートの開始行 → 終了行までループ
For lngRow = LNG_ROWSTART_WSガント To lngRowEnd
' 担当者が未入力の場合は次の行へ
If .Cells(lngRow, lngCol担当).Value = "" Then GoTo SkipRow
' 開始日・終了日が正常取得できない場合はエラー終了
If Not fncBln日付妥当性チェック( _
.Cells(lngRow, lng開始日列).Value, .Cells(lngRow, lng終了日列).Value, _
wsガント, lngRow, _
lng開始日列, lng終了日列, _
dic休業日) Then
Exit Sub
End If
' 対象行のセル情報から工数データクラスを生成
Set cls工数データ = fncCls工数データ生成(wsガント, lngRow, lngCol担当, lng工数列, lng開始日列, lng終了日列)
cls工数データ.工数セルアドレス = wsガント.Cells(lngRow, lng工数列).Address(False, False)
' ツール名を格納
cls工数データ.ツール名 = .Cells(lngRow, fncColumnLetterToNumber(typ列情報.ツール名)).Value
' 休業日ディクショナリを工数データへ連携
Set cls工数データ.dic休業日 = dic休業日
' 営業日数計算 → 工数データに格納
cls工数データ.日数 = cls工数データ.fncLng営業日数取得()
' 工数が未入力なら営業日数で補完
Call cls工数データ.prc工数自動補完
' 1営業日あたりの平均工数を算出してプロパティに格納
cls工数データ.平均工数1営業日 = cls工数データ.fncDbl平均工数1営業日()
' 工数データをコレクションに追加
clt工程一覧.Add cls工数データ
'確認出力
Debug.Print cls工数データ.fncToDebugString()
SkipRow:
Next lngRow
Next lng工程Idx
End With
' 営業日ゼロチェック（工数あり） → 処理を中断
If Not fncBln営業日ゼロ異常確認(clt工程一覧) Then Exit Sub
' 実工数異常チェック（異常があれば処理終了）
If Not fncBln1日平均工数確認(clt工程一覧) Then Exit Sub
' 集計レコード一覧を生成（Dictionary）
Set dic集計レコード = create集計レコード一覧(clt工程一覧)
' 工数明細シートに出力
Call output工数明細(dic集計レコード)
' 集計シートに出力
Call output集計表(dic集計レコード)
dat処理終了 = Now
Debug.Print Format(dat処理終了, "hh:nn:ss") & "：終了（処理時間: " & Format(dat処理終了 - dat処理開始, "hh:nn:ss") & ")"
Exit Sub
ERR_HANDLER:
MsgBox "処理中にエラーが発生しました。" & vbCrLf & _
"内容: " & Err.Description, vbCritical
Set cls工数データ = Nothing
Set dic休業日 = Nothing
Set clt工程一覧 = Nothing
Set wsガント = Nothing
Exit Sub
End Sub
'--------------------------------------------------
' プロシージャ名 : output集計表
' 概要 : cls集計レコードのDictionaryから「集計」シートへ氏名×日付の工数を集計出力
' 引数 : dic集計レコード - Dictionary（cls集計レコードを格納）
'--------------------------------------------------
Public Sub output集計表(ByVal dic集計レコード As Scripting.Dictionary)
Const COL_氏名 As Long = 1 ' 氏名列の列番号（A列=1）
Const ROW_氏名開始 As Long = 2 ' 氏名一覧の開始行（データ出力対象）
Const COL_日付開始 As Long = 2 ' 日付が始まる列番号（B列=2）
Const ROW_日付ヘッダー As Long = 1 ' 日付ヘッダーが記載されている行番号
Dim ws出力 As Worksheet
Dim dic氏名行 As Scripting.Dictionary
Dim dic対象氏名 As Scripting.Dictionary
Dim arr日付 As Variant
Dim arr出力() As Double
Dim varKey As Variant
Dim cls明細 As cls集計レコード
Dim lng行数 As Long, lng列数 As Long
Dim lng氏名行Idx As Long, lng日付列Idx As Long
Dim str氏名 As String
Dim dtm対象日 As Date
Dim arr氏名 As Variant
Dim rng氏名範囲 As Range
' 出力対象のシートを参照
Set ws出力 = ThisWorkbook.Worksheets(STR_WSNAME_集計)
' ヘッダーから日付を取得（1行目 B列～右端）
lng列数 = ws出力.Cells(ROW_日付ヘッダー, ws出力.Columns.Count).End(xlToLeft).Column - (COL_日付開始 - 1)
Const LNG_DATE_IDX_START As Long = 1
ReDim arr日付(LNG_DATE_IDX_START To lng列数)
Dim lng日付Idx As Long
For lng日付Idx = 1 To lng列数
arr日付(lng日付Idx) = ws出力.Cells(ROW_日付ヘッダー, lng日付Idx + (COL_日付開始 - 1)).Value
Next lng日付Idx
'--------------------------------------------------
' 対象となる氏名一覧を取得（cls集計レコードに登場する氏名のみを対象）
' → シートのA列にある全氏名のうち、出力すべき対象を限定するための前処理
'--------------------------------------------------
Set dic対象氏名 = New Scripting.Dictionary
' cls集計レコードの中から登場する氏名のみを対象として、辞書に登録する
' ※同一氏名が複数レコードに登場する可能性があるため、既存チェックを行う
For Each varKey In dic集計レコード.Keys
Set cls明細 = dic集計レコード(varKey)
' 対象氏名が未登録であれば、辞書に追加（重複回避）
If Not dic対象氏名.Exists(cls明細.str氏名) Then
dic対象氏名.Add cls明細.str氏名, True
End If
Next varKey
' シートのA列から氏名リストを取得（下端まで）
Set dic氏名行 = New Scripting.Dictionary
' 氏名列の有効範囲（最終行）を取得
Dim lng最終行_氏名 As Long
lng最終行_氏名 = ws出力.Cells(ws出力.Rows.Count, COL_氏名).End(xlUp).Row
' 氏名列の範囲オブジェクトを作成（開始行 ～ 最終行）
Set rng氏名範囲 = ws出力.Range(ws出力.Cells(ROW_氏名開始, COL_氏名), ws出力.Cells(lng最終行_氏名, COL_氏名))
arr氏名 = rng氏名範囲.Value
' 配列形式で取得できなかった場合（1セルのみ）、2次元配列に変換して扱えるようにする
If Not IsArray(arr氏名) Then
ReDim arr氏名(1 To 1, 1 To 1)
arr氏名(1, 1) = rng氏名範囲.Value
End If
' 集計対象の氏名のみを辞書に格納（行番号と対応）
lng行数 = UBound(arr氏名, 1)
Dim lng氏名Idx As Long
For lng氏名Idx = 1 To lng行数
str氏名 = Trim(arr氏名(lng氏名Idx, 1))
' 空白行はスキップ
If str氏名 = "" Then GoTo SkipRow
' 対象氏名のみに限定（集計レコードに含まれていない行は除外）
If Not dic対象氏名.Exists(str氏名) Then GoTo SkipRow
' 有効な氏名として辞書に登録
dic氏名行(str氏名) = lng氏名Idx
SkipRow:
Next lng氏名Idx
' 出力用2次元配列を初期化（氏名行数×日付列数）
ReDim arr出力(1 To lng行数, 1 To lng列数)
' 集計データの反映処理（氏名×日付ごとに工数を加算）
For Each varKey In dic集計レコード.Keys
Set cls明細 = dic集計レコード(varKey)
str氏名 = cls明細.str氏名
dtm対象日 = cls明細.dtm対象日
' 対象の氏名が存在する行を特定（行番号を取得）
If dic氏名行.Exists(str氏名) Then
lng氏名行Idx = dic氏名行(str氏名)
' 日付列を順に走査し、対象日と一致する列を見つけて工数を加算
' ※一致が見つかれば Exit For でループ終了（効率化）
For lng日付列Idx = 1 To lng列数
If arr日付(lng日付列Idx) = dtm対象日 Then
' 対象日の位置が一致した場合は、工数を加算してループ終了
arr出力(lng氏名行Idx, lng日付列Idx) = arr出力(lng氏名行Idx, lng日付列Idx) + cls明細.dbl工数
Exit For
End If
Next lng日付列Idx
End If
Next varKey
' シートに2次元配列で一括出力
ws出力.Range(ws出力.Cells(ROW_氏名開始, COL_日付開始), _
ws出力.Cells(ROW_氏名開始 + lng行数 - 1, COL_日付開始 + lng列数 - 1)).Value = arr出力
End Sub
Excel
コメント