VBAmacros创build组合

我正在为下面提到的情况写一个macros。

input是：

Col A Col B AB AC BD CA CB CE DA DB EA 

我正在尝试使组合如输出：

 ABDAACAACBDAACEABDBCA BDAC CACCBDACCEAC | | | 

等等

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

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

我简直无法弄清楚，如何创build一个这样的循环。

请提出一些想法。

Answer 1

有向图，避免循环和recursion。 美丽的挑战。 代码需要很多的改进，但是凌晨1点，我不得不在家里安装Excel：/

我假定你的数据在范围A1：B9。 解决scheme打印在立即窗口（由你自己格式的工作）。

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