アローダイヤグラムのパスをVBAで取得

20230130アローダイヤグラムのパスをVBAで取得


パソコン素人です。
プログラム素人です。

基本情報技術者試験の問題・テキスト等を見て気になったメモです。
多分間違っているのであまり見ないで下さい。すみません。


(記載内容や参考にしたネット情報など問題がありましたら、早急に削除いたします。)


「アローダイヤグラム」というのがある。
プロジェクトのマネジメントに使うそうです。
PERT図(Program Evaluation and Review Technique)
とも言い、各作業の所要時間などの情報を組み合わせて、
プロジェクト全体の流れを図表化したものだそうだ。

 



 

 

試験問題では、作業を効率的に終わらせるための「最長」ルート「クリティカルパス」を問われるらしいです。(最長というか結果効率的な最短というか・・・。)
今回は、「クリティカルパスを探す」というのではなく、VBAで、パス(通り道)を
全部取得してみようということです。
クリティカルパスまで探せたらいいのだけれど。力及ばず・・・。)


以下に、図(エクセルシート)を準備します。
問題文そのままではできないので、

問題文のアローダイヤグラムをエクセルシートに書き込みます。(sheet1)

 

 


(多分、表せていると思うのですが・・・)
ノード(結節点)をアルファベット、
矢印上の作業所要日数を数字にしています。
(作業日数自体は、計算してませんが、数字があることで次のノードにつながることを表しています。)


注意点
プログラムの都合上、上2行には、書き込まないこと(薄緑色部分)。
(列については、A列からでもいいですが、今回はスタートをB5セルにしました。)

黄色のF3セルですが、ノードB→ノードEは、「-」を入れています。
セルの関係上、ノードDとノードGに列を合わせるためです。

オレンジのH5セルですが、空白です。(色を付けただけ。)

G4セルとG6セルの作業日数は、それぞれノードEとノードHのためです。

 

結果表示用のシート2はこんな感じ。

 

以下コード

Option Explicit
Option Base 1  '面倒なので配列1始まり


'sheet1は2行下げる


Sub パス作成11()
    Dim start_range As String
    Dim node_ad As Variant
    Dim node_v As Variant
    Worksheets(2).Range("A2:A20").Value = ""
    Worksheets(1).Activate
    start_range = "B5"        'スタートのセル(ノード)

    node_ad = Worksheets(1).Range(start_range).Address
    node_v = Worksheets(1).Range(start_range).Value
    
    Dim node_path As Variant
    
'    MsgBox node_ad & "  " & node_v

    
    ReDim node_path(1 To 1)
    node_path(UBound(node_path)) = node_v   '最初は1個 A

    Call bunki(node_ad, node_v, node_path)  ' node_v(配列)も入れる 再帰(スタック 後入れ・先だし処理みたい)
'    Stop
End Sub

Private Sub bunki(node_ad, node_v, node_path)


    Dim next_node_ad As Variant
    Dim next_node_v As Variant
    
    
    '上、中、下で再帰するのでなく、それらを配列にして、forで回す(全ルート)
    Dim keiro_flg As Variant
    ReDim keiro_flg(1 To 3) '最大3個
    
    
     If Worksheets(1).Range(node_ad).Offset(-1, 1) <> "" Then '斜め上
        If Worksheets(1).Range(node_ad).Offset(-2, 2) <> "" Then
            keiro_flg(1) = 1
        End If
     End If
     
     If Worksheets(1).Range(node_ad).Offset(0, 1) <> "" Then  '横
        If Worksheets(1).Range(node_ad).Offset(0, 2) <> "" Then
            keiro_flg(2) = 2
        End If
     End If
    
     If Worksheets(1).Range(node_ad).Offset(1, 1) <> "" Then '斜め下
        If Worksheets(1).Range(node_ad).Offset(2, 2) <> "" Then
            keiro_flg(3) = 3
        End If
     End If
     

     
     Dim i As Variant
     
     For Each i In keiro_flg  '全部回す(このiはkeiro_flgの順のi)
        
'        MsgBox i
         If i = 1 Then '斜め上
            MsgBox "上 " & Worksheets(1).Range(node_ad).Offset(-1, 1)
            next_node_ad = Worksheets(1).Range(node_ad).Offset(-2, 2).Address
            next_node_v = Worksheets(1).Range(next_node_ad).Value  '新しいnode_adのv

            ReDim Preserve node_path(UBound(node_path) + 1)
            node_path(UBound(node_path)) = next_node_v


            Call bunki(next_node_ad, next_node_v, node_path) '再帰
        
    
        ElseIf i = 2 Then  '横
            MsgBox "横 " & Worksheets(1).Range(node_ad).Offset(0, 1)
            next_node_ad = Worksheets(1).Range(node_ad).Offset(0, 2).Address
            next_node_v = Worksheets(1).Range(next_node_ad).Value  '新しいnode_adのv

            ReDim Preserve node_path(UBound(node_path) + 1)
            node_path(UBound(node_path)) = next_node_v
        

            Call bunki(next_node_ad, next_node_v, node_path) '再帰
        
    
        ElseIf i = 3 Then '斜め下
            MsgBox "下 " & Worksheets(1).Range(node_ad).Offset(1, 1)
            next_node_ad = Worksheets(1).Range(node_ad).Offset(2, 2).Address
            next_node_v = Worksheets(1).Range(next_node_ad).Value  '新しいnode_adのv

            ReDim Preserve node_path(UBound(node_path) + 1)
            node_path(UBound(node_path)) = next_node_v


            Call bunki(next_node_ad, next_node_v, node_path) '再帰
        End If
         
     
     Next i
     
    '終了条件keiro_flgの要素がない時にする(行き止まり)
    If keiro_flg(1) = Empty And keiro_flg(2) = Empty And keiro_flg(3) = Empty Then
            'ここで配列は完成している
            'node_pathを書き込み
            With Worksheets(2)
                Worksheets(2).Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1) = Join(node_path, ",")
            End With
            'ここでパスを1個削る
            ReDim Preserve node_path(UBound(node_path) - 1)
        
        
            Exit Sub    'ここで巻き戻る(実際にはexit subというより、1個上の再帰(bunki)の最終地点に戻る)
    Else   '巻き戻りでもう1個上(行き止まり以外1個上)
            
            '本当の最後node_path(UBound(node_path) - 1が出るのでエラー(ubound1-1でエラー)処理
            
            If UBound(node_path) > 1 Then
                ReDim Preserve node_path(UBound(node_path) - 1)
            Else
            End If
        
            Exit Sub    'ここで巻き戻る(実際にはexit subというより、1個上の再帰(bunki)の最終地点に戻る)
            

    End If

End Sub

 

これを実行すると、下記になります。
sheet2の結果

 

 

 

もっと大きなものでもちゃんと再帰しているようです。
今回、再帰処理を自分で考えましたが、
VBA再帰は、「スタック(後入れ・先だし)」なんだろうなと思いました。

 

追記:メモクリティカルパス解き方

試験では、クリティカルパスを探す時、パスごとにかかる時間を合計することになる。

説明では、

A→B→C・・・15日

A→D→C・・・20日(こっちがクリティカルパス

というのもあれば、

A→B→C

A→D→C

までのパスの合計時間数を出して、ゴールから逆に各ノードまでの「余裕時間のない方」をクリティカルパスとして認定していく(説明がヘタ)方法があるが、どっちも理屈は同じだろう。

前からだと・・・遅い方

後ろからだと・・・余裕のない方

複雑な場合は、後ろからも見る方が確実なのかな。