1

下記の状況でマクロを書こうとしています。

入力は次のとおりです。

Col A   Col B
A       B
A       C
B       D
C       A
C       B
C       E
D       A
D       B
E       A

私は 出力のような組み合わせを作ろうとしています： 

A   B   D   A       
A   C   A           
A   C   B   D   A   
A   C   E   A       
B   D   B           
C   A   B   D   A   C
C   A   C           
C   B   D   A   C   
C   E   A   C

|
|
|

等々

出力は同じワークシートに置くことができます。

出力には、開始点と終了点が同じである必要があります。ループは最初の行から開始し、開始点と終了点が同じになるように組み合わせを探す必要があります。

このようなループを作成する方法を理解することはできません。

いくつかのアイデアを提案してください。

4

1 に答える 1

0

循環と再帰を回避する有向グラフ。美しい挑戦。コードには多くの改善が必要ですが、午前 1 時なので、自宅に Excel をインストールする必要がありました :/

データは A1:B9 の範囲にあると想定しています。解決策は Immediate Window に出力されます (書式は自分で作成します)。

Option Explicit

Sub EveningFun()

    Dim rCell As Range
    Dim rRng As Range

    Dim goal As String

    Dim availablePaths(1 To 9) As Boolean

    Dim i As Integer

    For i = 1 To 9
        availablePaths(i) = True
    Next i


    Set rRng = Sheet1.Range("A1:A9")

    For Each rCell In rRng.Cells
        goal = rCell.value

        Call RecursiveFun(goal, rCell.Offset(0, 1).value, goal, availablePaths)

    Next rCell

End Sub

Sub RecursiveFun(goal As String, nextElement As String, path As String, availablePaths() As Boolean)

    Dim rCell As Range
    Dim rRng As Range

    Set rRng = Sheet1.Range("A1:A9")

    For Each rCell In rRng.Cells

        If goal = nextElement Then
            'Debug.Print path & nextElement
             Range("D" & Rows.Count).End(xlUp).Cells.Offset(1, 0) = path & nextElement
             Exit Sub
        End If

        If nextElement = rCell.value And availablePaths(rCell.Row) Then
            Dim onePathLess(1 To 9) As Boolean
            Call CopyArrays(availablePaths(), onePathLess())
            'some key place, we have to avoid cycles
            onePathLess(rCell.Row) = False

            Call RecursiveFun(goal, rCell.Offset(0, 1).value, path & nextElement, onePathLess())
        End If

    Next rCell

End Sub

Sub CopyArrays(source() As Boolean, target() As Boolean)

    Dim i As Integer

    For i = 1 To 9
        target(i) = source(i)
    Next i

End Sub

非常に素晴らしい仕事の場合は +4 ですが、挑戦しない場合は -3 です。

于 2013-03-01T00:32:47.720 に答える