Question

我正在尝试为下面提到的情况编写一个宏。

输入为：

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

|
|
|

等等

输出可以在同一工作表上。

输出应该具有相同的起点和终点。循环应从第一行开始，并以起点和终点相同的方式查找组合。

我根本无法弄明白，如何创建这样的循环。

请提出一些建议。

Answer 1

定向图，避免循环和递归。美好的挑战。代码需要很多改进，但是凌晨1点我必须在家里安装Excel：/

我假设您的数据在A1：B9范围内。解决方案打印在立即窗口中（您自己的格式工作）。

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表示没有尝试。

用于创建组合的VBA宏

1 个答案: