Option Explicit
Option Base 1
'-----------------------------------------------
' 関数名 : fncBlnシート存在確認
' 機能概要 : 必須シートの存在を確認し、1つでも欠けていればエラーメッセージを表示
' 引数 : なし（関数内で配列を構成）
' 戻り値 : Boolean（True＝全シート存在、False＝欠落あり）
'-----------------------------------------------
Public Function fncBlnシート存在確認() As Boolean
Dim arr必須シート As Variant
arr必須シート = Array(STR_WSNAME_休業日, STR_WSNAME_集計, STR_WSNAME_ガント)
Dim strMsg As String
Dim var名 As Variant
Dim bln全存在 As Boolean
bln全存在 = True
For Each var名 In arr必須シート
On Error Resume Next
If ThisWorkbook.Sheets(var名) Is Nothing Then
strMsg = strMsg & var名 & vbCrLf
bln全存在 = False
End If
On Error GoTo 0
Next
If Not bln全存在 Then
MsgBox "以下の必須シートが存在しません。" & vbCrLf & vbCrLf & strMsg, vbExclamation
End If
fncBlnシート存在確認 = bln全存在
End Function
'-----------------------------------------------
' 列名（アルファベット）を列番号（数値）に変換する関数
' 引数: strColLetter : String型 - 変換対象の列名（例: "A", "H", "AA" など）
' 戻り値: Long型 - 対応する列番号（例: "A"→1, "H"→8, "AA"→27）
'-----------------------------------------------
Public Function fncColumnLetterToNumber(ByVal strColLetter As String) As Long
fncColumnLetterToNumber = Range(strColLetter & "1").Column
End Function
'-----------------------------------------------
' 列番号（数値）を列名（アルファベット）に変換する関数
' 引数: lngCol : Long型 - 変換対象の列番号（例: 1, 8, 27 など）
' 戻り値: String型 - 対応する列名（例: 1→"A", 8→"H", 27→"AA"）
'-----------------------------------------------
Public Function fncColumnNumberToLetter(ByVal lngCol As Long) As String
fncColumnNumberToLetter = Split(Cells(1, lngCol).Address(True, False), "$")(0)
End Function
'-----------------------------------------------
' 関数名 : fncBlnCheck工数値
' 機能概要 : ガントシート上の工数列に数値以外が含まれていないかを確認する
' 引数 : ws対象 - 対象のワークシート（ガント）
' : typ列情報 - ガント列定義構造体（工数列情報を含む）
' 戻り値 : Boolean（True＝正常、False＝数値以外あり）
'-----------------------------------------------
Public Function fncBlnCheck工数値( _
ByVal ws対象 As Worksheet, _
ByRef typ列情報 As typガント列定義 _
) As Boolean
Dim lngRowEnd As Long
Dim lngRow As Long
Dim lng工程Idx As Long
Dim lng工数列 As Long
Dim strMsg As String
Dim bln異常あり As Boolean
lngRowEnd = ws対象.Cells(ws対象.Rows.Count, typ列情報.ツール名).End(xlUp).Row
bln異常あり = False
strMsg = ""
For lng工程Idx = C_LNG_工程START To C_INT_工程END
lng工数列 = fncColumnLetterToNumber(typ列情報.工程(lng工程Idx).工数)
For lngRow = LNG_ROWSTART_WSガント To lngRowEnd
With ws対象.Cells(lngRow, lng工数列)
If .Value <> "" And Not IsNumeric(.Value) Then
strMsg = strMsg & "行: " & lngRow & " / セル: " & .Address(False, False) & " / 値: " & .Value & vbCrLf
bln異常あり = True
End If
End With
Next lngRow
Next lng工程Idx
If bln異常あり Then
MsgBox "工数列に数値以外のデータが含まれています。" & vbCrLf & vbCrLf & strMsg, vbExclamation
fncBlnCheck工数値 = False
Else
fncBlnCheck工数値 = True
End If
End Function
'-----------------------------------------------
' 関数名 : fnc休業日Dictionary取得
' 概要 : シート「休業日」からC列=1の行の日付をDictionaryに格納し返す
' 引数 : なし
' 戻り値 : Scripting.Dictionary型（キー：休業日）
'-----------------------------------------------
Function fnc休業日Dictionary取得() As Scripting.Dictionary
' 定数宣言
Const STRSHEET_休業日 As String = "休業日" ' カレンダーシート名
Const STRCOL_日付 As String = "A" ' 日付列
Const STRCOL_休業 As String = "C" ' 休業フラグ列
Const INT_休業日フラグ As Integer = 1 ' 休業日と判定する値
Const LNG_日付開始行 As Long = 2 ' データ開始行（1行目はタイトル）
Dim dic休業日 As Scripting.Dictionary
Dim wsCal As Worksheet
Dim lngRow As Long, lngLastRow As Long
Dim dat日付 As Date
Set dic休業日 = New Scripting.Dictionary
Set wsCal = ThisWorkbook.Sheets(STRSHEET_休業日)
lngLastRow = wsCal.Cells(wsCal.Rows.Count, STRCOL_日付).End(xlUp).Row
For lngRow = LNG_日付開始行 To lngLastRow
If CInt(wsCal.Cells(lngRow, STRCOL_休業).Value) = INT_休業日フラグ Then
dat日付 = wsCal.Cells(lngRow, STRCOL_日付).Value
If Not dic休業日.Exists(dat日付) Then dic休業日.Add dat日付, True
End If
Next lngRow
Set fnc休業日Dictionary取得 = dic休業日
End Function
'--------------------------------------------------
' 関数名 : fncBln営業日ゼロ異常確認
' 機能概要 : 営業日数が0なのに工数が入力されているデータを検出する
' 引数 : clt工数一覧 - cls工数データのCollection
' 戻り値 : Boolean型（True＝正常、False＝異常あり）
'--------------------------------------------------
Public Function fncBln営業日ゼロ異常確認(ByVal clt工数一覧 As Collection) As Boolean
Dim cls工数 As cls工数データ
Dim strMsg As String
Dim bln異常 As Boolean
For Each cls工数 In clt工数一覧
If cls工数.日数 = 0 And cls工数.工数 > 0 Then
strMsg = strMsg & "セル: " & cls工数.工数セルアドレス & _
" / 氏名: " & cls工数.氏名 & _
" / 工数名: " & cls工数.工程名 & _
" / 工数: " & cls工数.工数 & vbCrLf
bln異常 = True
End If
Next
If bln異常 Then
MsgBox "営業日数が0なのに工数が入力されているデータがあります。" & vbCrLf & vbCrLf & strMsg, vbExclamation
fncBln営業日ゼロ異常確認 = False
Else
fncBln営業日ゼロ異常確認 = True
End If
End Function
'-----------------------------------------------
' 関数名 : fncLng営業日数取得
' 概要 : 開始日～終了日の間で、休業日を除いた営業日数を返す
' 引数 : dat開始日 - 工程開始日
' dat終了日 - 工程終了日
' dic休業日 - 休業日Dictionary（キー：休業日）
' 戻り値 : Long型（営業日数）
'-----------------------------------------------
Function fncLng営業日数取得(ByVal dat開始日 As Date, ByVal dat終了日 As Date, ByVal dic休業日 As Scripting.Dictionary) As Long
Dim dat日付 As Date ' 日付カウント用
Dim lng営業日数 As Long ' 営業日数カウンタ
For dat日付 = dat開始日 To dat終了日
If Not dic休業日.Exists(dat日付) Then
lng営業日数 = lng営業日数 + 1
End If
Next dat日付
fncLng営業日数取得 = lng営業日数
End Function
'-----------------------------------------------
' 関数名 : fncBln日付妥当性チェック
' 機能概要 : 開始日と終了日の妥当性（未入力・日付型・前後関係）を検証し、異常時はErr.Raiseで呼出元に通知する
' 引数 : dat開始日 - 開始日（Variant型）
' dat終了日 - 終了日（Variant型）
' ws対象 - 対象シートオブジェクト（Worksheet型）
' lngRow - 行番号
' lng開始日列 - 開始日列番号
' lng終了日列 - 終了日列番号
' 戻り値 : Boolean - True: 妥当 / エラー時は例外送出（Err.Raise）
'-----------------------------------------------
Public Function fncBln日付妥当性チェック( _
ByVal dat開始日 As Variant, _
ByVal dat終了日 As Variant, _
ByVal ws対象 As Worksheet, _
ByVal lngRow As Long, _
ByVal lng開始日列 As Long, _
ByVal lng終了日列 As Long, _
ByVal dic休業日 As Scripting.Dictionary) As Boolean
Dim strセル範囲 As String
Dim strErrMsg As String
strセル範囲 = ws対象.Cells(lngRow, lng開始日列).Address(False, False)
strセル範囲 = strセル範囲 & " ～ " & ws対象.Cells(lngRow, lng終了日列).Address(False, False)
' 未入力チェック
If IsEmpty(dat開始日) Or IsEmpty(dat終了日) Then
strErrMsg = "エラー：開始日または終了日が未入力です。"
GoTo RAISE_ERROR
End If
' 日付型チェック
If Not IsDate(dat開始日) Or Not IsDate(dat終了日) Then
strErrMsg = "エラー：開始日または終了日が日付として認識できません。"
GoTo RAISE_ERROR
End If
' 前後関係チェック
If CDate(dat開始日) > CDate(dat終了日) Then
strErrMsg = "エラー：開始日が終了日より後になっています。"
GoTo RAISE_ERROR
End If
' 日付範囲チェック（1900年～2099年）
If Year(CDate(dat開始日)) < 1900 Or Year(CDate(dat終了日)) > 2099 Then
strErrMsg = "エラー：開始日または終了日が扱える日付範囲（1900～2099年）を超えています。"
GoTo RAISE_ERROR
End If
' 休日開始・終了チェック（休日が指定されている場合）
If Not dic休業日 Is Nothing Then
If dic休業日.Exists(CDate(dat開始日)) Or dic休業日.Exists(CDate(dat終了日)) Then
strErrMsg = "エラー：開始日または終了日が休業日です。"
GoTo RAISE_ERROR
End If
End If
' 正常終了
fncBln日付妥当性チェック = True
Exit Function
RAISE_ERROR:
' ※ユーザー定義エラー番号の基準定数+1001 で独自エラー生成
Err.Raise vbObjectError + 1001, _
"fncBln日付妥当性チェック", _
strErrMsg & vbCrLf _
& "セル位置：" & strセル範囲
End Function
'-----------------------------------------------
' 関数名 : fncCls工数データ生成
' 機能概要 : 対象セルから工数データクラスを生成し返す
' 引数 : ws対象 - 対象シート
' lngRow - 対象行番号
' lngCol担当 - 担当列番号
' lng工数列 - 工数列番号
' lng開始日列 - 開始日列番号
' lng終了日列 - 終了日列番号
' 戻り値 : cls工数データ型のインスタンス
'-----------------------------------------------
Public Function fncCls工数データ生成( _
ByVal ws対象 As Worksheet, _
ByVal lngRow As Long, _
ByVal lngCol担当 As Long, _
ByVal lng工数列 As Long, _
ByVal lng開始日列 As Long, _
ByVal lng終了日列 As Long _
) As cls工数データ
Dim cls工数 As New cls工数データ
cls工数.氏名 = Trim(ws対象.Cells(lngRow, lngCol担当).Value)
cls工数.工程名 = ws対象.Cells(1, lng工数列).Value
cls工数.開始日 = ws対象.Cells(lngRow, lng開始日列).Value
cls工数.終了日 = ws対象.Cells(lngRow, lng終了日列).Value
cls工数.工数 = ws対象.Cells(lngRow, lng工数列).Value
cls工数.行番号 = lngRow
Set fncCls工数データ生成 = cls工数
End Function
'-----------------------------------------------
' 関数名 : fncBln1日平均工数確認
' 機能概要 : 実工数が1を超えている工数データを検出し、警告表示する
' 引数 : col工程一覧 - cls工数データのCollection
' 戻り値 : Boolean型（True＝正常、False＝異常検出）
'-----------------------------------------------
Public Function fncBln1日平均工数確認(ByVal col工程一覧 As Collection) As Boolean
Dim cls工数 As cls工数データ ' 工数データ（1件）
Dim strMsg As String ' メッセージボックス出力用文字列
Dim dbl実工数 As Double ' 工数 ÷ 営業日数（小数第3位切り捨て）
Dim str出力 As String ' 個別行の出力行文字列
strMsg = "1日の工数が「１」を超えるデータが存在します" & vbCrLf & vbCrLf
For Each cls工数 In col工程一覧
' 実工数 = 工数 ÷ 営業日数（小数第3位切り捨て）
If cls工数.日数 > 0 Then
dbl実工数 = Int((cls工数.工数 / cls工数.日数) * 100) / 100
Else
dbl実工数 = 0
End If
' 実工数が1を超えている場合は異常としてメッセージ出力対象とする
If dbl実工数 > 1 Then
str出力 = "■セル: " & cls工数.工数セルアドレス & _
" / 開始: " & Format(cls工数.開始日, "yy/mm/dd(aaa)") & _
" / 終了: " & Format(cls工数.終了日, "yy/mm/dd(aaa)") & _
" / 営業日数: " & cls工数.日数 & _
" / 工数: " & cls工数.工数 & _
" / 平均: " & Format(dbl実工数, "0.00")
strMsg = strMsg & str出力 & vbCrLf
End If
Next cls工数
' 異常データが存在した場合はMsgBoxを表示しFalseを返す
If strMsg <> "1日の工数が「１」を超えるデータが存在します" & vbCrLf & vbCrLf Then
MsgBox strMsg, vbExclamation
fncBln1日平均工数確認 = False
Else
fncBln1日平均工数確認 = True
End If
End Function
Excel
コメント