難問 ： これでもEXCELの課題なんです(経路問題) http://www.moug.net/faq/viewtopic.php?t=65367

CountAllPaths.vb

Sub test()
    Debug.Print CountAllPaths(5, 5)   ' 70
    Debug.Print CountAllPaths(10, 10) ' 48620
    Debug.Print CountAllPaths(20, 20) ' 35345263800
End Sub

Function CountAllPaths(ByVal Row As Long, ByVal Col As Long) As Double
    Dim r As Long
    Dim c As Long

    If Row < 1 Or Col < 1 Then
        Error 5 ' プロシージャの呼び出し、または引数が不正です。
    End If

    ' パスカルの三角形を利用して経路数を求める
    ReDim Table(1 To Row, 1 To Col) As Double
    
    For r = 1 To Row
        Table(r, 1) = 1
    Next r
    For c = 1 To Col
        Table(1, c) = 1
    Next c
    
    For r = 2 To Row
        For c = 2 To Col
            Table(r, c) = Table(r, c - 1) + Table(r - 1, c)
        Next c
    Next r
    
    CountAllPaths = Table(Row, Col)
End Function

task1-2.vb

Option Explicit

Sub test()
    MsgBox Max(5, 5)
End Sub

Function Max(ByVal Row As Long, ByVal Col As Long) As Long
    Dim Paths As Variant
    Dim Path As Variant

    If Row < 1 Or Col < 1 Then
        Error 5 ' プロシージャの呼び出し、または引数が不正です。
    End If

    ' 全経路を列挙
    Paths = AllPaths(Row, Col)
    ' 経路内の数値を合計し、最大となる経路を求める
    Path = MaxPath(Paths)
    ' 最大となる経路に色付け
    Coloring Path(0)

    Max = Path(1)
End Function

' 全経路を列挙
Function AllPaths(ByVal Row As Long, ByVal Col As Long) As Variant
    Dim FinishedPaths As Variant
    Dim UnFinishedPaths As Collection
    Dim Path As Variant
    Dim n As Long
    Dim CurrentCell As Variant
    Dim NextCell As Variant
    Dim AnotherCell As Variant
    Dim AnotherPath As Variant

    If Row < 1 Or Col < 1 Then
        Error 5 ' プロシージャの呼び出し、または引数が不正です。
    End If

    FinishedPaths = Array()
    Set UnFinishedPaths = New Collection
    UnFinishedPaths.Add Array(Array(1, 1))
    
    Do
        n = UnFinishedPaths.Count
        If n = 0 Then Exit Do
        Path = UnFinishedPaths.Item(n)
        CurrentCell = Path(UBound(Path))

        Do
            If CurrentCell(0) = Row And CurrentCell(1) = Col Then
                Add FinishedPaths, Path
                UnFinishedPaths.Remove n
                Exit Do
            ElseIf CurrentCell(0) = Row Then
                NextCell = Array(CurrentCell(0), CurrentCell(1) + 1)
            Else
                NextCell = Array(CurrentCell(0) + 1, CurrentCell(1))
                If CurrentCell(1) < Col Then
                    AnotherCell = Array(CurrentCell(0), CurrentCell(1) + 1)
                    AnotherPath = Path
                    Add AnotherPath, AnotherCell
                    UnFinishedPaths.Add AnotherPath
                End If
            End If
            
            Add Path, NextCell
            CurrentCell = NextCell
        Loop
    Loop
    
    AllPaths = FinishedPaths
End Function

Sub Add(ByRef xs, ByVal x)
    Dim NextIndex As Long
    NextIndex = UBound(xs) + 1
    ReDim Preserve xs(NextIndex)
    xs(NextIndex) = x
End Sub

' 経路内の数値を合計し、最大となる経路を求める
Function MaxPath(ByVal Paths As Variant) As Variant
    Dim Max_ As Long
    Dim Sum_ As Long
    Dim x As Long
    Dim n As Long
    Dim i As Long

    x = 0
    Max_ = Sum(Paths(x))
    n = UBound(Paths)
    For i = 1 To n
        Sum_ = Sum(Paths(i))
        If Sum_ > Max_ Then
            Max_ = Sum_
            x = i
        End If
    Next i
    
    MaxPath = Array(Paths(x), Max_)
End Function

Function Sum(ByVal Path As Variant) As Double
    Dim Sum_ As Double
    Dim n As Long
    Dim i As Long
    
    Sum_ = 0
    n = UBound(Path)
    For i = 0 To n
        Sum_ = Sum_ + Cells(Path(i)(0), Path(i)(1)).Value
    Next i
    Sum = Sum_
End Function

Sub Coloring(ByVal Path As Variant)
    Dim n As Long
    Dim i As Long
    n = UBound(Path)
    For i = 0 To n
        Cells(Path(i)(0), Path(i)(1)).Interior.Color = vbYellow
    Next i
End Sub

task1-3.vb

Option Explicit

Sub test()
    MsgBox Max(5, 5)
End Sub

Function Max(ByVal Row As Long, ByVal Col As Long) As Long
    Dim Paths As Variant
    Dim Path As Variant

    If Row < 1 Or Col < 1 Then
        Error 5 ' プロシージャの呼び出し、または引数が不正です。
    End If

    ' 全経路を列挙
    Paths = AllPaths(Row, Col)
    ' 経路内の数値を合計し、最大となる経路を求める
    Path = MaxPath(Paths)
    ' 最大となる経路に色付け
    Coloring Path(0)

    Max = Path(1)
End Function

' 全経路を列挙
Function AllPaths(ByVal Row As Long, ByVal Col As Long) As Variant
    Dim FinishedPaths As Variant
    Dim UnFinishedPaths As Collection
    Dim PathCount As Double
    Dim i As Long
    Dim n As Long
    Dim Path As Variant
    Dim LastCellIndex As Long
    Dim Steps As Long
    Dim s As Long
    Dim CurrentCell As Variant
    Dim NextCell As Variant
    Dim AnotherCell As Variant
    Dim AnotherPath As Variant

    If Row < 1 Or Col < 1 Then
        Error 5 ' プロシージャの呼び出し、または引数が不正です。
    End If

    FinishedPaths = Array()
    Set UnFinishedPaths = New Collection
    UnFinishedPaths.Add Array(Array(1, 1))
    PathCount = CountAllPaths(Row, Col)
    
    For i = 1 To PathCount
        n = UnFinishedPaths.Count
        Path = UnFinishedPaths.Item(n)
        LastCellIndex = UBound(Path)
        CurrentCell = Path(LastCellIndex)
        Steps = Row + Col - 2 - LastCellIndex

        For s = 1 To Steps
            If CurrentCell(0) = Row Then
                NextCell = Array(CurrentCell(0), CurrentCell(1) + 1)
            Else
                NextCell = Array(CurrentCell(0) + 1, CurrentCell(1))
                If CurrentCell(1) < Col Then
                    AnotherCell = Array(CurrentCell(0), CurrentCell(1) + 1)
                    AnotherPath = Path
                    Add AnotherPath, AnotherCell
                    UnFinishedPaths.Add AnotherPath
                End If
            End If
            
            Add Path, NextCell
            CurrentCell = NextCell
        Next s

        Add FinishedPaths, Path
        UnFinishedPaths.Remove n
    Next i
    
    AllPaths = FinishedPaths
End Function

Function CountAllPaths(ByVal Row As Long, ByVal Col As Long) As Double
    Dim r As Long
    Dim c As Long

    If Row < 1 Or Col < 1 Then
        Error 5 ' プロシージャの呼び出し、または引数が不正です。
    End If

    ' パスカルの三角形を利用して経路数を求める
    ReDim Table(1 To Row, 1 To Col) As Double
    
    For r = 1 To Row
        Table(r, 1) = 1
    Next r
    For c = 1 To Col
        Table(1, c) = 1
    Next c
    
    For r = 2 To Row
        For c = 2 To Col
            Table(r, c) = Table(r, c - 1) + Table(r - 1, c)
        Next c
    Next r
    
    CountAllPaths = Table(Row, Col)
End Function

Sub Add(ByRef xs, ByVal x)
    Dim NextIndex As Long
    NextIndex = UBound(xs) + 1
    ReDim Preserve xs(NextIndex)
    xs(NextIndex) = x
End Sub

' 経路内の数値を合計し、最大となる経路を求める
Function MaxPath(ByVal Paths As Variant) As Variant
    Dim Max_ As Long
    Dim Sum_ As Long
    Dim x As Long
    Dim n As Long
    Dim i As Long

    x = 0
    Max_ = Sum(Paths(x))
    n = UBound(Paths)
    For i = 1 To n
        Sum_ = Sum(Paths(i))
        If Sum_ > Max_ Then
            Max_ = Sum_
            x = i
        End If
    Next i
    
    MaxPath = Array(Paths(x), Max_)
End Function

Function Sum(ByVal Path As Variant) As Double
    Dim Sum_ As Double
    Dim n As Long
    Dim i As Long
    
    Sum_ = 0
    n = UBound(Path)
    For i = 0 To n
        Sum_ = Sum_ + Cells(Path(i)(0), Path(i)(1)).Value
    Next i
    Sum = Sum_
End Function

Sub Coloring(ByVal Path As Variant)
    Dim n As Long
    Dim i As Long
    n = UBound(Path)
    For i = 0 To n
        Cells(Path(i)(0), Path(i)(1)).Interior.Color = vbYellow
    Next i
End Sub

task1.vb

Option Explicit

Sub test()
    MsgBox Max(5, 5)
End Sub

Function Max(ByVal Row As Long, ByVal Col As Long) As Variant
    Dim r As Long
    Dim c As Long
    Dim RightValue As Long
    Dim DownValue As Long
    Dim LargerValue As Long
    Dim LargerCell As Variant
    
    ReDim Table(1 To Row, 1 To Col)
    
    For r = Row To 1 Step -1
        For c = Col To 1 Step -1
            RightValue = 0
            DownValue = 0
            
            If c + 1 <= Col Then
                RightValue = Table(r, c + 1)(1)
            End If
            If r + 1 <= Row Then
                DownValue = Table(r + 1, c)(1)
            End If
            
            If RightValue > DownValue Then
                LargerValue = RightValue
                LargerCell = Array(r, c + 1)
            Else
                LargerValue = DownValue
                LargerCell = Array(r + 1, c)
            End If
            Table(r, c) = Array(LargerCell, Cells(r, c).Value + LargerValue)
        Next c
    Next r
    
    Coloring Table
    Max = Table(1, 1)(1)
End Function

Sub Coloring(ByVal Table As Variant)
    Dim MaxRow As Long
    Dim MaxCol As Long
    Dim NextRow As Long
    Dim NextCol As Long
    Dim NextCell As Variant
    
    MaxRow = UBound(Table, 1)
    MaxCol = UBound(Table, 2)
    NextRow = 1
    NextCol = 1
    
    Do
        Cells(NextRow, NextCol).Interior.Color = vbYellow
        If NextRow = MaxRow And NextCol = MaxCol Then
            Exit Do
        End If
        NextCell = Table(NextRow, NextCol)(0)
        NextRow = NextCell(0)
        NextCol = NextCell(1)
    Loop
End Sub

task2.vb

Option Explicit

Sub test()
    Dim Total As Variant
    Total = Max(10, 10)
    Coloring Total(0), UBound(Total(0))
    MsgBox Total(1)
End Sub

Function Max(ByVal Row As Long, ByVal Col As Long) As Variant
    Dim UpTotal As Variant
    Dim LeftTotal As Variant
    Dim Total As Variant
    Dim Path As Variant

    If Row < 1 Or Col < 1 Then
        Error 5 ' プロシージャの呼び出し、または引数が不正です。
    End If

    If Row = 1 And Col = 1 Then
        Total = Array(Array(), 0)
    ElseIf Row = 1 Then
        Total = Max(Row, Col - 1)
    ElseIf Col = 1 Then
        Total = Max(Row - 1, Col)
    Else
        UpTotal = Max(Row - 1, Col)
        LeftTotal = Max(Row, Col - 1)
        Total = IIf(UpTotal(1) > LeftTotal(1), UpTotal, LeftTotal)
    End If

    Path = Total(0)
    Add Path, Array(Row, Col)
    Max = Array(Path, Cells(Row, Col).Value + Total(1))
End Function

Sub Add(ByRef xs, ByVal x)
    Dim NextIndex As Long
    NextIndex = UBound(xs) + 1
    ReDim Preserve xs(NextIndex)
    xs(NextIndex) = x
End Sub

Sub Coloring(ByVal Path As Variant, ByVal i As Long)
    If i < 0 Then Exit Sub
    Cells(Path(i)(0), Path(i)(1)).Interior.Color = vbYellow
    Coloring Path, i - 1
End Sub

task3.vb

Option Explicit

Sub test()
    Dim Total As Variant
    Total = Max(20, 20)
    Coloring Total(0), UBound(Total(0))
    MsgBox Total(1)
End Sub

Function Max(ByVal Row As Long, ByVal Col As Long) As Variant
    Static Memo As New Collection
    Dim Params As String
    Dim Visited As Boolean
    Dim UpTotal As Variant
    Dim LeftTotal As Variant
    Dim Total As Variant
    Dim Path As Variant

    Params = Row & "," & Col
    On Error Resume Next
    Max = Memo.Item(Params)
    Visited = Err.Number = 0
    On Error GoTo 0
    If Visited Then Exit Function

    If Row < 1 Or Col < 1 Then
        Max = Array(Array(), 0)
    Else
        UpTotal = Max(Row - 1, Col)
        LeftTotal = Max(Row, Col - 1)
        Total = IIf(UpTotal(1) > LeftTotal(1), UpTotal, LeftTotal)
        
        Path = Total(0)
        Add Path, Array(Row, Col)
        Max = Array(Path, Cells(Row, Col).Value + Total(1))
    End If
    
    Memo.Add Max, Params
End Function

Sub Add(ByRef xs, ByVal x)
    Dim NextIndex As Long
    NextIndex = UBound(xs) + 1
    ReDim Preserve xs(NextIndex)
    xs(NextIndex) = x
End Sub

Sub Coloring(ByVal Path As Variant, ByVal i As Long)
    If i < 0 Then Exit Sub
    Cells(Path(i)(0), Path(i)(1)).Interior.Color = vbYellow
    Coloring Path, i - 1
End Sub

課題

初めて質問させていただきます。 
どうぞよろしくお願いします。 
 
下記のように1から9までの数字が、ランダムにA1から並んでいます。 
 
     Ａ Ｂ Ｃ Ｄ Ｅ・・・・・・・・・・ 
1} 8 1 4 5 5 ・・・・・・・・・・ 
2} 3 5 2 7 8 ・・・・・・・・・・ 
3} 2 4 3 2 3 ・・・・・・・・・・ 
4} 4 6 7 7 1 ・・・・・・・・・・ 
5} 9 9 1 9 3 ・・・・・・・・・・ 
・ 
・ 
与えられた範囲の一番左上のセルからスタートし、一番右下のセルまで一つずつセル移動していく。 
セルの移動は右または下にしか移動できない。 
 
この時、経路内のセルの数値の合計が最大となる経路を求めセルを着色し最大値を示せ。 
・ 
課題 1) 
 A1:E5 (5行x5列)の範囲を考える。 
 70の経路が考えられるが、全ての経路を求め合計値を計算し最大値及び経路を求める。 
 これを For～Next文を用いてプログラミングせよ。 
 
課題 2) 
 A1:J10 (10行x10列)の範囲を考える。 
 48,620の経路が考えられるが、同様に最大値及びその経路を求める。 
 ただし課題1を参考にして再帰処理を用いてプログラミングせよ。 
 
課題 3) 
 A1:T20 (20行x20列)の範囲を考える。 
 経路数は350億を超える。 
 課題2のプログラムを改良し、妥当な時間で処理が完了するプログラムを作れ。 
 
以上が課題ですが、経路をどう網羅的にはじき出すのか、色々考えてはみたのですがうまい方法が見つからず、とっかかりが掴めません。 
 
何かヒントを頂けるとありがたいです。

おもしろそうなのでHaskellでも解いてみました。
https://gist.github.com/haiiro-shimeji/4712482
セルの抽出、色付けの処理が無いのも大きいんですが、それでもコンパクトに実装できますね

今見ました。
やっべー、Haskell忘れてるー(汗)