Option Explicit
Option Base 1
'--------------------------------------------------
' プロシージャ名 : create集計レコード一覧
' 概要 : 工数データコレクションから営業日単位でcls集計レコードを生成しDictionaryに格納
' 引数 : clt工数一覧 - cls工数データのCollection
' 戻り値 : Dictionary(キー：工数セルアドレス|対象日, 値：cls集計レコード)
'--------------------------------------------------
Public Function create集計レコード一覧( _
ByVal clt工数一覧 As Collection _
) As Scripting.Dictionary
Dim dic集計レコード As Scripting.Dictionary
Set dic集計レコード = New Scripting.Dictionary
Dim cls工数 As cls工数データ
Dim cls明細 As cls集計レコード
Dim dtm日付 As Date
Dim strキー As String
On Error GoTo ERR_HANDLER
For Each cls工数 In clt工数一覧
' 工数が0ならスキップ
If cls工数.工数 = 0 Then GoTo SkipNext
' 開始日～終了日の範囲でループ（営業日のみ）
For dtm日付 = cls工数.開始日 To cls工数.終了日
' 休業日はスキップ
If cls工数.dic休業日.Exists(dtm日付) Then GoTo SkipDate
strキー = cls工数.工数セルアドレス & "|" & Format(dtm日付, "yyyy/mm/dd")
Set cls明細 = New cls集計レコード
cls明細.lng項番 = cls工数.行番号
cls明細.strツール名 = cls工数.ツール名
cls明細.str氏名 = cls工数.氏名
cls明細.str工程名 = cls工数.工程名
cls明細.dtm対象日 = dtm日付
cls明細.dbl工数 = cls工数.平均工数1営業日
cls明細.dbl元工数 = cls工数.工数
cls明細.dtm開始日 = cls工数.開始日
cls明細.dtm終了日 = cls工数.終了日
cls明細.lng営業日数 = cls工数.日数
cls明細.str工数セルアドレス = cls工数.工数セルアドレス
dic集計レコード.Add strキー, cls明細
SkipDate:
Next dtm日付
SkipNext:
Next cls工数
Set create集計レコード一覧 = dic集計レコード
Exit Function
ERR_HANDLER:
MsgBox "create集計レコード一覧 でエラーが発生しました。" & vbCrLf & _
"内容: " & Err.Description, vbCritical
Set create集計レコード一覧 = Nothing
End Function
'--------------------------------------------------
' プロシージャ名 : output集計レコード一覧Debug
' 概要 : Dictionaryに格納されたcls集計レコードの内容をデバッグ出力
' 引数 : dic集計レコード - Dictionary（cls集計レコードを格納）
'--------------------------------------------------
Public Sub output集計レコード一覧Debug(ByVal dic集計レコード As Scripting.Dictionary)
Dim varKey As Variant
Dim cls明細 As cls集計レコード
Debug.Print "===== 集計レコード出力（Debug） ====="
For Each varKey In dic集計レコード.Keys
Set cls明細 = dic集計レコード(varKey)
Debug.Print cls明細.fncToDebugString()
Next varKey
Debug.Print "===== 出力完了：" & dic集計レコード.Count & " 件 ====="
End Sub
'--------------------------------------------------
' プロシージャ名 : output工数明細
' 概要 : cls集計レコードのDictionaryから「工数明細」シートへ出力する
' 引数 : dic集計レコード - 明細データのDictionary
'--------------------------------------------------
Public Sub output工数明細(ByVal dic集計レコード As Scripting.Dictionary)
Const COL_FIRST As Long = 1
Const FORMAT_日付 As String = "yyyy/mm/dd(aaa)"
Const FORMAT_工数 As String = "0.00"
Const COL_対象日 As Long = 5
Const COL_平均工数 As Long = 6
Const COL_元工数 As Long = 7
Const COL_開始日 As Long = 9
Const COL_終了日 As Long = 10
Dim ws出力 As Worksheet
Dim strシート名 As String
Dim cls明細 As cls集計レコード
Dim varKey As Variant
Dim arrOutput() As Variant
Dim i As Long
Dim lng最終行 As Long
Dim lng最終列 As Long
strシート名 = "工数明細"
' シートの初期化（既存シートがあればクリア、なければ追加）
On Error Resume Next
Set ws出力 = ThisWorkbook.Worksheets(strシート名)
If ws出力 Is Nothing Then
Set ws出力 = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws出力.Name = strシート名
Else
ws出力.Cells.Clear
End If
On Error GoTo 0
' ヘッダー行の出力
With ws出力
.Cells(1, 1).Value = "項番"
.Cells(1, 2).Value = "ツール名"
.Cells(1, 3).Value = "氏名"
.Cells(1, 4).Value = "工程名"
.Cells(1, 5).Value = "対象日"
.Cells(1, 6).Value = "平均工数"
.Cells(1, 7).Value = "元工数"
.Cells(1, 8).Value = "営業日数"
.Cells(1, 9).Value = "開始日"
.Cells(1, 10).Value = "終了日"
.Cells(1, 11).Value = "工数セルアドレス"
End With
' 明細データを配列に格納
ReDim arrOutput(1 To dic集計レコード.Count, 1 To 11)
i = 1
For Each varKey In dic集計レコード.Keys
Set cls明細 = dic集計レコード(varKey)
arrOutput(i, 1) = cls明細.lng項番
arrOutput(i, 2) = cls明細.strツール名
arrOutput(i, 3) = cls明細.str氏名
arrOutput(i, 4) = cls明細.str工程名
arrOutput(i, 5) = cls明細.dtm対象日
arrOutput(i, 6) = cls明細.dbl工数
arrOutput(i, 7) = cls明細.dbl元工数
arrOutput(i, 8) = cls明細.lng営業日数
arrOutput(i, 9) = cls明細.dtm開始日
arrOutput(i, 10) = cls明細.dtm終了日
arrOutput(i, 11) = cls明細.str工数セルアドレス
i = i + 1
Next varKey
' 最終行・列を変数に格納
lng最終行 = UBound(arrOutput, 1)
lng最終列 = UBound(arrOutput, 2)
' 配列を一括出力
ws出力.Range("A2").Resize(lng最終行, lng最終列).Value = arrOutput
' 書式設定の適用
Dim lng列 As Long
With ws出力
For lng列 = COL_FIRST To lng最終列
Select Case lng列
Case COL_対象日, COL_開始日, COL_終了日
.Columns(lng列).NumberFormatLocal = FORMAT_日付
Case COL_平均工数, COL_元工数
.Columns(lng列).NumberFormatLocal = FORMAT_工数
End Select
Next lng列
End With
' 列幅を自動調整
ws出力.UsedRange.Columns.AutoFit
End Sub
Excel
コメント