Hinemos Utilityツールのジョブ-親ジョブ関係からジョブIDが第何階層に当たるのかを調べる

条件としては、
・ジョブIDは重複していない
・ジョブIDのレコード最大数はシートの制約で5000
・階層構造は10階層まで
・第１階層はTOPを親ジョブに持つジョブユニット１つのみ
・階層の深さを知るのが目的であって、階層構造そのものは分からない

Option Explicit

'################
'###  初期部  ###
'################

'*** 引数を取得
Dim cArguments
Set cArguments = WScript.Arguments

'*** 引数が１つ以外の場合は使い方を表示して終了
If cArguments.Count <> 1 Then
    msgbox "単一のHinemos UtilityツールのExcelブックを本スクリプト上にドラッグアンドドロップしてください。" & vbCrLf & "cArguments.Count = " & cArguments.Count,48,"使い方"
    WScript.Quit
Else
    '*** 拡張子でマクロ付きエクセルファイルであることを確認
    If Right(cArguments(0), Len(".xlsm")) = ".xlsm" Then
        Dim sFilePath
        sFilePath = cArguments(0)
    Else
        msgbox "単一のHinemos UtilityツールのExcelブックを本スクリプト上にドラッグアンドドロップしてください。" & vbCrLf & "sFilePath = " & sFilePath,48,"使い方"
        WScript.Quit
    End If
End If


'################
'###  関数部  ###
'################

'*** 配列内完全一致検索関数「Is_ExistArray」の定義
'*** 第１引数：検査対象配列
'*** 第２引数：検索文字列
'*** 戻り値　：完全一致有り→True
'*** 　　　　：完全一致無し→False
Function Is_ExistArray(arrTarget,sWord)
    Dim iExistArray
        Is_ExistArray = False
        For iExistArray = LBound(arrTarget) To UBound(arrTarget)
            If arrTarget(iExistArray) = sWord Then
                Is_ExistArray = True
                Exit For
            End If
        Next
End Function


'################
'###  実行部  ###
'################

'*** ExcelアプリケーションでHinemos Utilityツールを開く
Dim AppExcel
Set AppExcel = CreateObject("Excel.Application")
Dim oWorkBook
Set oWorkBook = AppExcel.Workbooks.Open(sFilePath,,True)

'*** Sheet「ジョブデータ」を取得
Dim i, oWorkSheet
For i = 1 To oWorkBook.WorkSheets.Count
    If oWorkBook.WorkSheets(i).Name = "ジョブデータ" Then
        Set oWorkSheet = oWorkBook.WorkSheets(i)
    End If
Next

If IsEmpty(oWorkSheet) = True Then
    oWorkBook.Close(False)
    AppExcel.Quit
    Set AppExcel = Nothing
    msgbox "単一のHinemos UtilityツールのExcelブックを本スクリプト上にドラッグアンドドロップしてください。" & vbCrLf & "ジョブデータSheetが見つかりません。",48,"使い方"
    WScript.Quit
End If

'*** 最大レコード行数を取得
Dim flgLoop : flgLoop = True
Dim iRow    : iRow    = 16 'レコードは17行目から開始
Dim iMax
Do Until flgLoop = False
    iRow = iRow + 1
    If oWorkSheet.Cells(iRow, 2).Value = "" Then flgLoop = False
Loop
iMax = iRow - 1 'レコード無しの行がiRowなので、レコードはこの１行手前まで存在する

'*** ジョブリスト二次元配列(親ジョブ,ジョブID)を作成
Dim arrJobList(5000, 2)
For iRow = 1 To iMax - 16
    arrJobList(iRow, 1) = oWorkSheet.Cells(iRow + 16, 3).Value '親ジョブ
    arrJobList(iRow, 2) = oWorkSheet.Cells(iRow + 16, 2).Value 'ジョブID
Next

'*** 第１～１０階層ジョブ構造一次元配列を作成
Dim arrJobList_1(5000), iJobList_1
Dim arrJobList_2(5000), iJobList_2
Dim arrJobList_3(5000), iJobList_3
Dim arrJobList_4(5000), iJobList_4
Dim arrJobList_5(5000), iJobList_5
Dim arrJobList_6(5000), iJobList_6
Dim arrJobList_7(5000), iJobList_7
Dim arrJobList_8(5000), iJobList_8
Dim arrJobList_9(5000), iJobList_9
Dim arrJobList_10(5000), iJobList_10

'*** 第1階層ジョブ構造一次元配列に、以下の条件に一致するジョブID「arrJobList(iRow, 2)」を格納
'***   ジョブリスト二次元配列内の親ジョブ「arrJobList(iRow, 1)」が
'***   「Top」と一致する場合
iJobList_1 = 1
For iRow = 1 To iMax - 16
    If arrJobList(iRow, 1) = "TOP" Then
        arrJobList_1(iJobList_1) = arrJobList(iRow, 2)
        iJobList_1 = iJobList_1 + 1
    End If
Next

'*** 第2階層ジョブ構造一次元配列に、以下の条件に一致するジョブID「arrJobList(iRow, 2)」を格納
'***   ジョブリスト二次元配列内の親ジョブ「arrJobList(iRow, 1)」が
'***   第1階層ジョブ構造一次元配列内の各ジョブID「arrJobList_1(iJobList_1)」と一致する場合
iJobList_1 = 1
iJobList_2 = 1
For iRow = 1 To iMax - 16
    For iJobList_1 = 1 To UBound(arrJobList_1)
        If arrJobList(iRow, 1) = arrJobList_1(iJobList_1) Then
            arrJobList_2(iJobList_2) = arrJobList(iRow, 2)
            iJobList_2 = iJobList_2 + 1
        End If
    Next
Next

'*** 第3階層ジョブ構造一次元配列に、以下の条件に一致するジョブID「arrJobList(iRow, 2)」を格納
'***   ジョブリスト二次元配列内の親ジョブ「arrJobList(iRow, 1)」が
'***   第2階層ジョブ構造一次元配列内の各ジョブID「arrJobList_2(iJobList_2)」と一致する場合
iJobList_2 = 1
iJobList_3 = 1
For iRow = 1 To iMax - 16
    For iJobList_2 = 1 To UBound(arrJobList_2)
        If arrJobList(iRow, 1) = arrJobList_2(iJobList_2) Then
            arrJobList_3(iJobList_3) = arrJobList(iRow, 2)
            iJobList_3 = iJobList_3 + 1
        End If
    Next
Next

'*** 第4階層ジョブ構造一次元配列に、以下の条件に一致するジョブID「arrJobList(iRow, 2)」を格納
'***   ジョブリスト二次元配列内の親ジョブ「arrJobList(iRow, 1)」が
'***   第3階層ジョブ構造一次元配列内の各ジョブID「arrJobList_3(iJobList_3)」と一致する場合
iJobList_3 = 1
iJobList_4 = 1
For iRow = 1 To iMax - 16
    For iJobList_3 = 1 To UBound(arrJobList_3)
        If arrJobList(iRow, 1) = arrJobList_3(iJobList_3) Then
            arrJobList_4(iJobList_4) = arrJobList(iRow, 2)
            iJobList_4 = iJobList_4 + 1
        End If
    Next
Next

'*** 第5階層ジョブ構造一次元配列に、以下の条件に一致するジョブID「arrJobList(iRow, 2)」を格納
'***   ジョブリスト二次元配列内の親ジョブ「arrJobList(iRow, 1)」が
'***   第4階層ジョブ構造一次元配列内の各ジョブID「arrJobList_4(iJobList_4)」と一致する場合
iJobList_4 = 1
iJobList_5 = 1
For iRow = 1 To iMax - 16
    For iJobList_4 = 1 To UBound(arrJobList_4)
        If arrJobList(iRow, 1) = arrJobList_4(iJobList_4) Then
            arrJobList_5(iJobList_5) = arrJobList(iRow, 2)
            iJobList_5 = iJobList_5 + 1
        End If
    Next
Next

'*** 第6階層ジョブ構造一次元配列に、以下の条件に一致するジョブID「arrJobList(iRow, 2)」を格納
'***   ジョブリスト二次元配列内の親ジョブ「arrJobList(iRow, 1)」が
'***   第5階層ジョブ構造一次元配列内の各ジョブID「arrJobList_5(iJobList_5)」と一致する場合
iJobList_5 = 1
iJobList_6 = 1
For iRow = 1 To iMax - 16
    For iJobList_5 = 1 To UBound(arrJobList_5)
        If arrJobList(iRow, 1) = arrJobList_5(iJobList_5) Then
            arrJobList_6(iJobList_6) = arrJobList(iRow, 2)
            iJobList_6 = iJobList_6 + 1
        End If
    Next
Next

'*** 第7階層ジョブ構造一次元配列に、以下の条件に一致するジョブID「arrJobList(iRow, 2)」を格納
'***   ジョブリスト二次元配列内の親ジョブ「arrJobList(iRow, 1)」が
'***   第6階層ジョブ構造一次元配列内の各ジョブID「arrJobList_6(iJobList_6)」と一致する場合
iJobList_6 = 1
iJobList_7 = 1
For iRow = 1 To iMax - 16
    For iJobList_6 = 1 To UBound(arrJobList_6)
        If arrJobList(iRow, 1) = arrJobList_6(iJobList_6) Then
            arrJobList_7(iJobList_7) = arrJobList(iRow, 2)
            iJobList_7 = iJobList_7 + 1
        End If
    Next
Next

'*** 第8階層ジョブ構造一次元配列に、以下の条件に一致するジョブID「arrJobList(iRow, 2)」を格納
'***   ジョブリスト二次元配列内の親ジョブ「arrJobList(iRow, 1)」が
'***   第7階層ジョブ構造一次元配列内の各ジョブID「arrJobList_7(iJobList_7)」と一致する場合
iJobList_7 = 1
iJobList_8 = 1
For iRow = 1 To iMax - 16
    For iJobList_7 = 1 To UBound(arrJobList_7)
        If arrJobList(iRow, 1) = arrJobList_7(iJobList_7) Then
            arrJobList_8(iJobList_8) = arrJobList(iRow, 2)
            iJobList_8 = iJobList_8 + 1
        End If
    Next
Next

'*** 第9階層ジョブ構造一次元配列に、以下の条件に一致するジョブID「arrJobList(iRow, 2)」を格納
'***   ジョブリスト二次元配列内の親ジョブ「arrJobList(iRow, 1)」が
'***   第8階層ジョブ構造一次元配列内の各ジョブID「arrJobList_8(iJobList_8)」と一致する場合
iJobList_8 = 1
iJobList_9 = 1
For iRow = 1 To iMax - 16
    For iJobList_8 = 1 To UBound(arrJobList_8)
        If arrJobList(iRow, 1) = arrJobList_8(iJobList_8) Then
            arrJobList_9(iJobList_9) = arrJobList(iRow, 2)
            iJobList_9 = iJobList_9 + 1
        End If
    Next
Next

'*** 第10階層ジョブ構造一次元配列に、以下の条件に一致するジョブID「arrJobList(iRow, 2)」を格納
'***   ジョブリスト二次元配列内の親ジョブ「arrJobList(iRow, 1)」が
'***   第9階層ジョブ構造一次元配列内の各ジョブID「arrJobList_9(iJobList_9)」と一致する場合
iJobList_9 = 1
iJobList_10 = 1
For iRow = 1 To iMax - 16
    For iJobList_9 = 1 To UBound(arrJobList_9)
        If arrJobList(iRow, 1) = arrJobList_9(iJobList_9) Then
            arrJobList_10(iJobList_10) = arrJobList(iRow, 2)
            iJobList_10 = iJobList_10 + 1
        End If
    Next
Next

Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oLog
Set oLog = fso.CreateTextFile(Left(WScript.ScriptFullName, Len(Wscript.ScriptFullName) - Len(Wscript.ScriptName)) & Wscript.ScriptName & ".txt")
For iJobList_1  = 1 To UBound(arrJobList_1)  - 1 : If arrJobList_1(iJobList_1)   <> "" Then oLog.WriteLine "1"  & String(1,  vbTab) & arrJobList_1(iJobList_1)   End If : Next
For iJobList_2  = 1 To UBound(arrJobList_2)  - 1 : If arrJobList_2(iJobList_2)   <> "" Then oLog.WriteLine "2"  & String(2,  vbTab) & arrJobList_2(iJobList_2)   End If : Next
For iJobList_3  = 1 To UBound(arrJobList_3)  - 1 : If arrJobList_3(iJobList_3)   <> "" Then oLog.WriteLine "3"  & String(3,  vbTab) & arrJobList_3(iJobList_3)   End If : Next
For iJobList_4  = 1 To UBound(arrJobList_4)  - 1 : If arrJobList_4(iJobList_4)   <> "" Then oLog.WriteLine "4"  & String(4,  vbTab) & arrJobList_4(iJobList_4)   End If : Next
For iJobList_5  = 1 To UBound(arrJobList_5)  - 1 : If arrJobList_5(iJobList_5)   <> "" Then oLog.WriteLine "5"  & String(5,  vbTab) & arrJobList_5(iJobList_5)   End If : Next
For iJobList_6  = 1 To UBound(arrJobList_6)  - 1 : If arrJobList_6(iJobList_6)   <> "" Then oLog.WriteLine "6"  & String(6,  vbTab) & arrJobList_6(iJobList_6)   End If : Next
For iJobList_7  = 1 To UBound(arrJobList_7)  - 1 : If arrJobList_7(iJobList_7)   <> "" Then oLog.WriteLine "7"  & String(7,  vbTab) & arrJobList_7(iJobList_7)   End If : Next
For iJobList_8  = 1 To UBound(arrJobList_8)  - 1 : If arrJobList_8(iJobList_8)   <> "" Then oLog.WriteLine "8"  & String(8,  vbTab) & arrJobList_8(iJobList_8)   End If : Next
For iJobList_9  = 1 To UBound(arrJobList_9)  - 1 : If arrJobList_9(iJobList_9)   <> "" Then oLog.WriteLine "9"  & String(9,  vbTab) & arrJobList_9(iJobList_9)   End If : Next
For iJobList_10 = 1 To UBound(arrJobList_10) - 1 : If arrJobList_10(iJobList_10) <> "" Then oLog.WriteLine "10" & String(10, vbTab) & arrJobList_10(iJobList_10) End If : Next


'################
'###  終了部  ###
'################

oLog.Close
Set oLog = Nothing

oWorkBook.Close(False)
AppExcel.Quit
Set AppExcel = Nothing

msgbox "End of script.",,"exit 0"
WScript.Quit