通過數字

Question

問題的表生成每一個可能的鏈條被接受的答案

我的代碼下面的工作表上運行的作者所理解。代碼創建所需的輸出，但我只能通過有七個嵌套循環來防止代碼進入無限循環;每行數據一個。目前的數據只是一個例子，最多17行的表格是預期的，所以這不是一個實際的方法。

數字表在C7：G23的範圍內。鏈條從範圍C7：G7開始。單元格C7中的單元格1導致行1，該單元格由列A中的1標識。範圍C8：G8指定1後面可以跟着2，空白，空白，4或空白。空白表示鏈條的末端。 2和4標識鏈中下一個可能的鏈接。當每個可能的鏈被識別時，它被輸出到I1：P1下的下一個空閒行。

任何人都可以建議如何實現這個輸出沒有無限循環的風險，並沒有一個數字表中的每行嵌套循環？

Row| A |B| C | D | E | F | G |H|I|J|K|L|M|N|O|P| 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
    1| | | | | | | | | Test 3  | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
    2| | | | | | | | |1|2| | | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
    3| | | | | | | | |1|2|3|4|6| | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
    4| | | | | | | | |1|2|3|4|6| | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
    5| | | | | | | | |1|2|3|4|6|5| | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
    6| | |Col1|Col2|Col3|Col4|Col5| |1|2|3|4|6|5| | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
    7|Rows| | 1 | | | | | |1|2|3|4|6|5| | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
    8| 1| | 2 | | | 4 | | |1|2|3|4|6|5| | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
    9| 2| | | 3 | | | | |1|2|3|4|6|5| | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
10| 3| | 4 | | | | | |1|2|3|4|6| | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
11| 4| | 6 | | | | | |1|2|3|4|6| | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
12| 5| | | | | | | |1|2|3|4| | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
13| 6| | | | 5 | | | |1|2|3|4| | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
14| 7| | | | | | | |1|2|3|4| | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
15| 8| | | | | | | |1|2|3|4| | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
16| 9| | | | | | | |1|2|3| | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
17| 10| | | | | | | |1|2|3| | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
18| 11| | | | | | | |1|2|3| | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
19| 12| | | | | | | |1|2|3| | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
20| 13| | | | | | | |1|2| | | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
21| 14| | | | | | | |1|2| | | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
22| 15| | | | | | | |1|2| | | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
23| 16| | | | | | | |1| | | | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
24| | | | | | | | |1| | | | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
25| | | | | | | | |1|4|6| | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
26| | | | | | | | |1|4|6| | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
27| | | | | | | | |1|4|6|5| | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
28| | | | | | | | |1|4|6|5| | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
29| | | | | | | | |1|4|6|5| | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
30| | | | | | | | |1|4|6|5| | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
31| | | | | | | | |1|4|6|5| | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
32| | | | | | | | |1|4|6| | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
33| | | | | | | | |1|4|6| | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
34| | | | | | | | |1|4| | | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
35| | | | | | | | |1|4| | | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
36| | | | | | | | |1|4| | | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
37| | | | | | | | |1|4| | | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 
38| | | | | | | | |1| | | | | | | | 
    |----+-+----+----+----+----+----+-+-+-+-+-+-+-+-+-| 

原標題：Excel的VBA - 如何避免X倍「的下一個」中環路「爲下一個」循環找到X行的模板中的細胞組合和5列

原始問題：

我所做的代碼工作完美！但僅僅是因爲我重複了7次（由於7行）在「for next」循環中的「for next」循環....（見下文）。

Sub test3() 

Range("I2:P40").ClearContents 

' "Tableau" means matrix in french 
Dim Tableau() As Long 
' "l" means row (it is like r) 
ReDim Tableau(l) 
l = 0 

' "l0" means row 0 (it is like r0) 
Dim l0 As Long 
Dim Pass As Long 
l0 = 7 
Pass = 2 

'"PlagePX" Range of row addresses. To take in account for combinations in the matrix 
Dim PlagePX As Range 
Set PlagePX = Range(Cells(l0, 1), Cells(23, 1)) 

Cells(l0, 1).Select 
Cells(l0, 3).Select 
' "CL" means columns of row1,2,3,4,5,... (it is like RC1,2,3,4,5,...) 
For CL1 = 1 To 5 
    If IsEmpty(Cells(l0, 3)) = False Then 
     ReDim Preserve Tableau(l) 
     Tableau(l) = Application.WorksheetFunction.Match(Cells(l0, 3).Value, PlagePX, 0) + 6 
     Cells(Tableau(l), 1).Select 
     Cells(Tableau(l), 2 + CL1).Select 
     Cells(Pass, 9) = Cells(l0, 3).Value 
     Cells(Pass, 10) = Cells(Tableau(l), 2 + CL1).Value 
     l = l + 1 
    Else 
     Cells(Pass, 9) = Cells(l0, 3).Value 
     Exit For 
    End If 
    For CL2 = 1 To 5 
     If IsEmpty(Cells(Tableau(l - 1), 2 + CL1)) = False Then 
      ReDim Preserve Tableau(l) 
      Tableau(l) = Application.WorksheetFunction.Match(Cells(Tableau(l - 1), 2 + CL1).Value, PlagePX, 0) + 6 
      Cells(Tableau(l), 1).Select 
      Cells(Tableau(l), 2 + CL2).Select 
      Cells(Pass, 9) = Cells(l0, 3).Value 
      Cells(Pass, 10) = Cells(Tableau(l - 1), 2 + CL1).Value 
      Cells(Pass, 11) = Cells(Tableau(l), 2 + CL2).Value 
      l = l + 1 
     Else 
      Cells(Pass, 9) = Cells(l0, 3).Value 
      Cells(Pass, 10) = Cells(Tableau(l - 1), 2 + CL1).Value 
      Pass = Pass + 1 
      Exit For 
     End If 
     For CL3 = 1 To 5 
      If IsEmpty(Cells(Tableau(l - 1), 2 + CL2)) = False Then 
       ReDim Preserve Tableau(l) 
       Tableau(l) = Application.WorksheetFunction.Match(Cells(Tableau(l - 1), 2 + CL2).Value, PlagePX, 0) + 6 
       Cells(Tableau(l), 1).Select 
       Cells(Tableau(l), 2 + CL3).Select 
       Cells(Pass, 9) = Cells(l0, 3).Value 
       Cells(Pass, 10) = Cells(Tableau(l - 2), 2 + CL1).Value 
       Cells(Pass, 11) = Cells(Tableau(l - 1), 2 + CL2).Value 
       Cells(Pass, 12) = Cells(Tableau(l), 2 + CL3).Value 
       l = l + 1 
      Else 
       Cells(Pass, 9) = Cells(l0, 3).Value 
       Cells(Pass, 10) = Cells(Tableau(l - 2), 2 + CL1).Value 
       Cells(Pass, 11) = Cells(Tableau(l - 1), 2 + CL2).Value 
       Pass = Pass + 1 
       Exit For 
      End If 
      For CL4 = 1 To 5 
       If IsEmpty(Cells(Tableau(l - 1), 2 + CL3)) = False Then 
        ReDim Preserve Tableau(l) 
        Tableau(l) = Application.WorksheetFunction.Match(Cells(Tableau(l - 1), 2 + CL3).Value, PlagePX, 0) + 6 
        Cells(Tableau(l), 1).Select 
        Cells(Tableau(l), 2 + CL4).Select 
        Cells(Pass, 9) = Cells(l0, 3).Value 
        Cells(Pass, 10) = Cells(Tableau(l - 3), 2 + CL1).Value 
        Cells(Pass, 11) = Cells(Tableau(l - 2), 2 + CL2).Value 
        Cells(Pass, 12) = Cells(Tableau(l - 1), 2 + CL3).Value 
        Cells(Pass, 13) = Cells(Tableau(l), 2 + CL4).Value 
        l = l + 1 
       Else 
        Cells(Pass, 9) = Cells(l0, 3).Value 
        Cells(Pass, 10) = Cells(Tableau(l - 3), 2 + CL1).Value 
        Cells(Pass, 11) = Cells(Tableau(l - 2), 2 + CL2).Value 
        Cells(Pass, 12) = Cells(Tableau(l - 1), 2 + CL3).Value 
        Pass = Pass + 1 
        Exit For 
       End If 
       For CL5 = 1 To 5 
        If IsEmpty(Cells(Tableau(l - 1), 2 + CL4)) = False Then 
         ReDim Preserve Tableau(l) 
         Tableau(l) = Application.WorksheetFunction.Match(Cells(Tableau(l - 1), 2 + CL4).Value, PlagePX, 0) + 6 
         Cells(Tableau(l), 1).Select 
         Cells(Tableau(l), 2 + CL5).Select 
         Cells(Pass, 9) = Cells(l0, 3).Value 
         Cells(Pass, 10) = Cells(Tableau(l - 4), 2 + CL1).Value 
         Cells(Pass, 11) = Cells(Tableau(l - 3), 2 + CL2).Value 
         Cells(Pass, 12) = Cells(Tableau(l - 2), 2 + CL3).Value 
         Cells(Pass, 13) = Cells(Tableau(l - 1), 2 + CL4).Value 
         Cells(Pass, 14) = Cells(Tableau(l), 2 + CL5).Value 
         l = l + 1 
        Else 
         Cells(Pass, 9) = Cells(l0, 3).Value 
         Cells(Pass, 10) = Cells(Tableau(l - 4), 2 + CL1).Value 
         Cells(Pass, 11) = Cells(Tableau(l - 3), 2 + CL2).Value 
         Cells(Pass, 12) = Cells(Tableau(l - 2), 2 + CL3).Value 
         Cells(Pass, 13) = Cells(Tableau(l - 1), 2 + CL4).Value 
         Pass = Pass + 1 
         Exit For 
        End If 
        For CL6 = 1 To 5 
         If IsEmpty(Cells(Tableau(l - 1), 2 + CL5)) = False Then 
          ReDim Preserve Tableau(l) 
          Tableau(l) = Application.WorksheetFunction.Match(Cells(Tableau(l - 1), 2 + CL5).Value, PlagePX, 0) + 6 
          Cells(Tableau(l), 1).Select 
          Cells(Tableau(l), 2 + CL6).Select 
          Cells(Pass, 9) = Cells(l0, 3).Value 
          Cells(Pass, 10) = Cells(Tableau(l - 5), 2 + CL1).Value 
          Cells(Pass, 11) = Cells(Tableau(l - 4), 2 + CL2).Value 
          Cells(Pass, 12) = Cells(Tableau(l - 3), 2 + CL3).Value 
          Cells(Pass, 13) = Cells(Tableau(l - 2), 2 + CL4).Value 
          Cells(Pass, 14) = Cells(Tableau(l - 1), 2 + CL5).Value 
          Cells(Pass, 15) = Cells(Tableau(l), 2 + CL6).Value 
          l = l + 1 
         Else 
          Cells(Pass, 9) = Cells(l0, 3).Value 
          Cells(Pass, 10) = Cells(Tableau(l - 5), 2 + CL1).Value 
          Cells(Pass, 11) = Cells(Tableau(l - 4), 2 + CL2).Value 
          Cells(Pass, 12) = Cells(Tableau(l - 3), 2 + CL3).Value 
          Cells(Pass, 13) = Cells(Tableau(l - 2), 2 + CL4).Value 
          Cells(Pass, 14) = Cells(Tableau(l - 1), 2 + CL5).Value 
          Pass = Pass + 1 
          Exit For 
         End If 

         'The question is which approach I should follow for X rows, 
          'to avoid repeating again and again a "For Next" loop in a "For Next" loop??? 

         For CL7 = 1 To 5 
          If IsEmpty(Cells(Tableau(l - 1), 2 + CL6)) = False Then 
           ReDim Preserve Tableau(l) 
           Tableau(l) = Application.WorksheetFunction.Match(Cells(Tableau(l - 1), 2 + CL6).Value, PlagePX, 0) + 6 
           Cells(Tableau(l), 1).Select 
           Cells(Tableau(l), 2 + CL7).Select 
           Cells(Pass, 9) = Cells(l0, 3).Value 
           Cells(Pass, 10) = Cells(Tableau(l - 6), 2 + CL1).Value 
           Cells(Pass, 11) = Cells(Tableau(l - 5), 2 + CL2).Value 
           Cells(Pass, 12) = Cells(Tableau(l - 4), 2 + CL3).Value 
           Cells(Pass, 13) = Cells(Tableau(l - 3), 2 + CL4).Value 
           Cells(Pass, 14) = Cells(Tableau(l - 2), 2 + CL5).Value 
           Cells(Pass, 15) = Cells(Tableau(l - 1), 2 + CL6).Value 
           Cells(Pass, 16) = Cells(Tableau(l), 2 + CL7).Value 
          Else 
           Cells(Pass, 9) = Cells(l0, 3).Value 
           Cells(Pass, 10) = Cells(Tableau(l - 6), 2 + CL1).Value 
           Cells(Pass, 11) = Cells(Tableau(l - 5), 2 + CL2).Value 
           Cells(Pass, 12) = Cells(Tableau(l - 4), 2 + CL3).Value 
           Cells(Pass, 13) = Cells(Tableau(l - 3), 2 + CL4).Value 
           Cells(Pass, 14) = Cells(Tableau(l - 2), 2 + CL5).Value 
           Cells(Pass, 15) = Cells(Tableau(l - 1), 2 + CL6).Value 
           Pass = Pass + 1 
           Exit For 
          End If 

          Pass = Pass + 1 
         Next 
         l = l - 1 
        Next 
        l = l - 1 
       Next 
       l = l - 1 
      Next 
      l = l - 1 
     Next 
     l = l - 1 
    Next 
    l = l - 1 
Next 

MsgBox "fin" 


End Sub 

SO， 問題是：如何做到這一點，當你有X行，以避免無限「爲下一個」循環???? 有沒有人有答案或告訴我應該遵循哪種方法？

Answer 1

我已經完全測試了我的代碼。我增加了數據表的高度和寬度，並且包含了錯誤的值。但是，用真實值進行測試是不可替代的。讓我知道是否有任何輸入值無法給出您期望的結果。

我還沒有研究過你的代碼。有可能我會找到一個簡單的校正來防止無限循環。但是，找到這種簡單的校正將需要很長時間，代碼仍然依賴於當前的表格大小。下面的代碼是全新的。

我將提到：

• C6：G6作爲數據表頭。
• C7：G23作爲數據表。
• I2：P100作爲結果表。

我的代碼首先發現數據表的真實大小。也就是說，我的代碼並不假設數據表是5列寬或17行深。

我的宏需要數據表頭爲數據表的每一列包含一個文本值。您已使用「Col1」，「Col2」，「Col3」等。我的代碼不依賴於這些名稱，但它確實對每列都有一個值進行回覆。

如果將光標定位到單元格C6，然後單擊按Ctrl +右鍵，光標跳到單元格G6。如果你不熟悉Ctrl + 箭頭，有一個遊戲，看看光標如何移動。我的代碼使VBA等同於查找數據表頭的最後一列。

現在我知道數據表的寬度，我可以定義一個範圍該寬度包括所有行的。然後，我可以從底部搜索這個範圍，爲第一行添加一個值。這給了我數據表的最後一行。

我現在可以將整個數據表作爲數組加載到Variant變量中。

所有的代碼上面做是在子程序LoadDataTable。我有一個子程序TestLoadDataTable證明數據表已通過輸出表，立即窗口，以便正確裝入：

Row Col01 Col02 Col03 Col04 Col05 
    0  1       
    1  2     4  
    2   3     
    3  4       
    4  6   5 

我有「0」，你有「綠色啓動細胞」但除此之外，這符合您的數據表。

當工作表區域被加載到一個變型中，所述陣列總是具有1標題中的列數的下界以上是用於陣列的真實列號。左列中的行數是小於1的真實行數。我沒有將列A加載到此數組;因爲我不需要這些值。如果你的行不是以數字順序（按照你的例子），我們需要一些額外的步驟，但這不是問題。

我加載數據到一個數組，因爲它更快，更方便地獲取數據從一個陣列。

如果您不確定上述任何情況，請嘗試。嘗試不同數量的行和列，查看輸出的是什麼宏TestLoadDataTable。減少TestLoadDataTable和LoadDataTable並研究每條語句的成就。在線搜索任何您不知道的定義聲明。

隨着主程序在數據表中運行，序列將會增長。 （1）然後發現（1 2）然後（1 2 3）然後（1 2 3 4）然後（1 2 3 4 6）。我將在數組中保持不斷增長的序列。

我可以用ReDim Preserve增長的數組，但我儘量避免ReDim Preserve時，我可以。 ReDim Preserve是一個非常有用的聲明，但它是一個非常昂貴的聲明。解釋器必須爲新的較大陣列找到空間，從舊陣列中複製數據，初始化新部分並釋放舊陣列以進行垃圾回收。隨着陣列變得越來越大，這需要越來越長的時間，宏可以放慢抓取速度。

如果數據表是N行，序列不能有N + 1個值不重複的行。如果我將一個數組的大小設置爲擁有N + 1個條目的序列，我知道無需重複就可以填充它。起初我認爲這足以防止無限循環。但是，我可以設計數據表，在填充數組之前產生大量的半增長序列。相反，我會檢查一個新的條目，對照序列中的所有以前的條目;重複將顯示錯誤。

我有兩種方法來管理序列。我不認爲第一種方法會令人滿意，但我會解釋它。

對於第一種方法，我會有待處理的數組或集合。你知道陣列。 「集合」是大多數編程語言稱爲「列表」的東西。你從集合中讀取的方式與從數組讀取的方式相同。您可以輕鬆地添加新條目或從集合中刪除現有條目。數組訪問比集合更快。下面的描述是高層次的，所以選擇或數組或集合無關緊要。

在等待的每個條目都將是不完整的序列。

我首先在數據表的第一行中爲每個值放置一個條目。您的第一行第一列中有「1」。我不知道你是否可以在第一行有多個值，但很容易考慮到這種可能性。在你的例子中，我將有一個條目包含序列（1）在待定中。然後，我會循環執行以下步驟，直到Pending爲空。

對於每一個循環，我都會收到Pending最後一個條目的副本，然後從Pending中刪除最後一個條目。如果我將該副本稱爲「工作」，則以您的示例爲例，「工作」包含（1）和「待處理」現在爲空。 （1 2），（1空），（1空），（1 4）和（1空），可以看到該序列可能的擴展名爲1， 。表格的序列（1爲空）已完成，可寫入結果表格。序列（1 2）和（1 4）被添加到待定。

對於循環的第二次重複，Pending現在有兩個條目。該代碼將最後一項 - （1 4） - 複製到Work並從待處理中刪除。可能的擴展名是（1 4 6），（1 4空），（1 4空），（1 4空）和（1 4空）。序列（1 4空）已完成，可寫入結果表。序列（1 4 6）被添加到待定。

如果您在紙上運行此序列，您可以快速查看它是如何爲結果表生成結果的。循環中的代碼很少，代碼的數量遠遠少於您的代碼。你可能需要一段時間玩這個想法，但一旦掌握了，這很容易理解。的一面是，在結果表中的條目將在一個很奇怪的序列：（1），（1），（1），（1），（1 4），（1 4），（1 4）， （1 4），（1 4 6），（1 4 6），（1 4 6），（1 4 6），（1 4 6 5），（1 4 6 5），（1 4 6 5）， （1 4 6 5），（1 2）等。也許你會對這個序列感到滿意。注意：我不明白爲什麼您對結果表中的重複項感到滿意，但保留了它們以匹配結果表。

另一種方法涉及遞歸。遞歸是另一個想法，直到突然它很容易才能理解。我將它與駕駛進行比較。你在第一課結束時已經知道，你將永遠無法控制一個車輪，三個踏板，一個變速桿，同時看着擋風玻璃並檢查後視鏡。但一個月後，你不記得你發現困難。

假設您有調用ProcessC的ProcessA調用ProcessC。大多數初學者似乎對解釋器爲所有ProcessA數據找到內存的想法感到滿意。他們也對ProcessA調用ProcessB時的解決方案感到滿意，解釋器爲ProcessB的數據找到更多的內存，因此ProcessA的數據是安全的，直到它再次被需要。當調用ProcessC時，ProcessA的數據和ProcessB的數據都保持安全。如果ProcessA調用ProcessA，接受解釋器的一大步驟是在第二個副本運行時保持ProcessA數據的第一個副本安全嗎？

要讓ProcessA自行調用，需要ProcessA迭代。將（1）擴展爲（1 4），將（1 4）擴展爲（1 4 6）並將擴展（1 4 6）改爲（1 4 6 5）都是同樣的問題，因此您可以使用相同的代碼，自己的數據，爲每個擴展。

您需要三個例程，我將調用Control，ExtendOrOutput和Output。在調用ExtendOrOutput（（1））之前，控制會加載數據表並初始化結果表，其中（1）是初始序列。 （1）到（1 2），（1空），（1空），（1 4）和（1空）。 。所有這些可能的擴展需要處理：

Call ExtendOrOutput((1 2)) 
Call Output((1 empty)) 
Call Output((1 empty)) 
Call ExtendOrOutput((1 4)) 
Call Output((1 empty)) 

現在Call ExtendOrOutput ((1 2))將做同樣給：

Call Output((1 2 empty)) 
Call ExtendOrOutput((1 2 3)) 
Call Output((1 2 empty)) 
Call Output((1 2 empty)) 
Call Output((1 2 empty)) 

調用子程序的性質意味着Call ExtendOrOutput((1 2))下的一切是第一個`調用輸出之前執行（ （1空）），因此在這些調用執行順序是：

Call ExtendOrOutput((1 2)) 
    Call Output((1 2 empty)) 
    Call ExtendOrOutput((1 2 3)) 
     Call ExtendOrOutput((1 2 3 4)) 
      Call ExtendOrOutput((1 2 3 4 6)) 
       Call Output((1 2 3 4 6 empty)) 
       Call Output((1 2 3 4 6 empty)) 
       Call ExtendOrOutput((1 2 3 4 6 5)) 
        Call Output((1 2 3 4 6 5 empty)) 
        Call Output((1 2 3 4 6 5 empty)) 
        Call Output((1 2 3 4 6 5 empty)) 
        Call Output((1 2 3 4 6 5 empty)) 
        Call Output((1 2 3 4 6 5 empty)) 
       Call Output((1 2 3 4 6 empty)) 
       Call Output((1 2 3 4 6 empty)) 
      Call Output((1 2 3 4 empty)) 
      Call Output((1 2 3 4 empty)) 
      Call Output((1 2 3 4 empty)) 
      Call Output((1 2 3 4 empty)) 
     Call Output((1 2 3 empty)) 
     Call Output((1 2 3 empty)) 
     Call Output((1 2 3 empty)) 
     Call Output((1 2 3 empty)) 
    Call Output((1 2 empty)) 
    Call Output((1 2 empty)) 
    Call Output((1 2 empty)) 
Call Output((1 empty)) 
Call Output((1 empty)) 
Call ExtendOrOutput((1 4)) 
Call Output((1 empty)) 

如果掃描下來Call Output SY ou會看到結果表中的結果與您目前的結果相同。

我不直接向工作表輸出結果。相反，我創建了一個數組ResultsTable，並輸出到該數組。我已經指定這個數組爲1,000行。如果我填滿陣列，我放棄。我不知道你爲什麼需要這些序列，但我認爲1,000是綽綽有餘的。如有必要，您可以增加或減少1,000。如果這是不可接受的，我還有其他想法。

Option Explicit 

    ' Constants are a good way of defining values that might change in the future 
    Const ColWshtDataTableLeft As Long = 3 
    Const RowWshtDataTableHdr As Long = 6 
    Const WshtName As String = "Data"  ' Change to your name for the worksheet 
Sub Control() 

    ' Call LoadDataTable to copy the Data Table to an array 
    ' Call ExtendOrOutput to create the Result Table of all chain through the Data Table 

    Dim ColDataTableCrnt As Long 
    Dim ColResultsTableCrnt As Long 
    Dim ColWshtCrnt As Long 
    Dim ColWshtResultTableLeft As Long 
    Dim DataTable As Variant 
    Dim ResultsTable As Variant 
    Dim RowDataTableCrnt As Long 
    Dim RowResultsTableCrnt As Long 
    Dim RowResultsTableCrntMax As Long 
    Dim Sequence() As Variant 

    Call LoadDataTable(DataTable) ' Load Data Table 

    ' First column of Results Table which leave a blank column between Data Table 
    ' and Results Table. 
    ColWshtResultTableLeft = ColWshtDataTableLeft + UBound(DataTable, 2) + 1 

    With Worksheets(WshtName) 
    ' Delete columns to be used by Results Table plus those to the right or Results Table 
    .Columns(ColNumToCode(ColWshtResultTableLeft) & ":" & _ 
      ColNumToCode(Columns.Count)).Delete 
    ' Merge cells of header for Results Table. Width of Results Table is discussed below. 
    .Range(.Cells(1, ColWshtResultTableLeft), _ 
      .Cells(1, ColNumToCode(ColWshtResultTableLeft + UBound(DataTable, 1) + 1))).Merge 
    With .Cells(1, ColWshtResultTableLeft) 
     .Value = "Results Table" 
     .HorizontalAlignment = xlCenter 
    End With 
    End With 

    ' Size ResultsTable. Allow for 1,000 rows which I assume is more than could possibly 
    ' be required. Width is height of Data Table + 2. "height of Data Table" allows a 
    ' sequence to reference every row of the Data Table. I use the first extra column as 
    ' a test for an over run. I do not think this is possible becuase of test for repeat 
    ' row but thismakes absolute sure. I use to second extra column for an "error word" 
    ' such as "Repeat" or "Overrun". 
    ReDim ResultsTable(1 To 1000, 1 To UBound(DataTable, 1) + 2) 
    RowResultsTableCrntMax = 0  ' Last used row in ResultsTable 

    '' Write values to ResultsTable to confirm entire table written to worksheet 
    'For RowResultsTableCrnt = 1 To UBound(ResultsTable, 1) 
    ' For ColResultsTableCrnt = 1 To UBound(ResultsTable, 2) 
    ' ResultsTable(RowResultsTableCrnt, ColResultsTableCrnt) = "'" & RowResultsTableCrnt & ":" & ColResultsTableCrnt 
    ' Next 
    'Next 

    ' Initialise the Sequence array 
    ReDim Sequence(0 To UBound(ResultsTable, 2)) 
    Sequence(0) = 1  ' Last entry used 

    ' Call ExtendOrOutput for every non-empty column in top row of DataTable. 
    ' I know there will be a value in the first column. I do not know if there 
    ' could be a value in later columns but no harm looking. 
    For ColDataTableCrnt = 1 To UBound(DataTable, 2) 
    If Not IsEmpty(DataTable(1, ColDataTableCrnt)) Then 
     Sequence(1) = DataTable(1, ColDataTableCrnt) 
     Call ExtendOrOutput(DataTable, ResultsTable, RowResultsTableCrntMax, Sequence) 
    End If 
    Next 

    ' Output ResultTable to row 2 of Results Table in worksheet 
    With Worksheets(WshtName) 
    .Range(.Cells(2, ColWshtResultTableLeft), _ 
      .Cells(UBound(ResultsTable, 1) + 1, _ 
        ColWshtResultTableLeft + UBound(ResultsTable, 2) - 1)).Value = ResultsTable 
    End With 

End Sub 
Sub ExtendOrOutput(ByRef DataTable As Variant, ByRef ResultsTable As Variant, _ 
        ByRef RowResultsTableCrntMax As Long, ByRef Sequence() As Variant) 

    ' * DataTable as loaded from the worksheet. Values within DataTable are row 
    ' numbers within DataTable except the value recorded is one less than the 
    ' actual row number. Note: because DataTable has been loaded from a 
    ' worksheet, dimension 1 is for rows and dimension 2 is columns. 
    ' * ResultsTable be will loaded with completed sequences by Output. Note: because 
    ' ResultsTable is to be written to a worksheet, dimensions are as for DataTable. 
    ' ResultsTable has two more columns than should be necessary. In the event of 
    ' an error with a sequence, an error word will be written to the last column. 
    ' "Repeat" means a row number has repeated. "Overrun" means a value has been 
    ' written to the penultimate column which should not be possible. 
    ' * RowResultsTableCrntMax is the last currentlt used row within ResultsTable. 
    ' * Sequence contains a sequence of row numbers which this routine will attempt 
    ' to extend. If it cannot be extended, it is output to ResultsTable. 
    ' Its definition is (0 to N+2) where N is the number of rows in DataTable. 
    ' Entry 0 is used to hold the number of the last used entry within Sequence. 
    ' Entry N+1 and N+2 are used as explained above under Results Table. 

    Dim ColDataTableCrnt As Long 
    Dim InxSequenceCrnt As Long 
    Dim InxSequenceMax As Long 
    Dim RepeatFound As Boolean 
    Dim RowDataTableCrnt As Long 

    If RowResultsTableCrntMax > UBound(ResultsTable, 1) Then 
    ' Results Table is full 
    Exit Sub 
    End If 

    InxSequenceMax = Sequence(0)     ' Last used entry in Sequence 

    RowDataTableCrnt = Sequence(InxSequenceMax) + 1 ' Last value in Sequence + 1 

    For ColDataTableCrnt = 1 To UBound(DataTable, 2) 
    If IsEmpty(DataTable(RowDataTableCrnt, ColDataTableCrnt)) Then 
     ' This sequence is complete 
     Call Output(ResultsTable, RowResultsTableCrntMax, Sequence) 
    Else 
     ' This sequence can be extended 
     InxSequenceMax = InxSequenceMax + 1 
     Sequence(InxSequenceMax) = DataTable(RowDataTableCrnt, ColDataTableCrnt) 
     Sequence(UBound(Sequence)) = ""  ' No error 
     If IsNumeric(Sequence(InxSequenceMax)) Then 
     ' Value is numeric but is it in range 
     If Sequence(InxSequenceMax) > -1 And Sequence(InxSequenceMax) < UBound(DataTable, 1) Then 
      ' Value is a valid row number 
      RepeatFound = False 
      For InxSequenceCrnt = 1 To InxSequenceMax - 1 
      If Sequence(InxSequenceCrnt) = Sequence(InxSequenceMax) Then 
       ' Repeated value 
       RepeatFound = True 
       Sequence(UBound(Sequence)) = "Repeat" 
       Call Output(ResultsTable, RowResultsTableCrntMax, Sequence) 
      End If 
      Next 
      If Not RepeatFound Then 
      ' No repeat but is this an overrun? 
      If InxSequenceMax + 1 = UBound(Sequence) Then 
       ' Have overrun. I don't think this is possible 
       Debug.Assert False 
       Sequence(UBound(Sequence)) = "Overrun" 
       Call Output(ResultsTable, RowResultsTableCrntMax, Sequence) 
      Else 
       ' Have good extension 
       Sequence(0) = Sequence(0) + 1 
       Call ExtendOrOutput(DataTable, ResultsTable, RowResultsTableCrntMax, Sequence) 
       Sequence(0) = Sequence(0) - 1 
      End If 
      End If 
     Else 
      ' Value is out of range 
      Sequence(UBound(Sequence)) = "Out of range" 
      Call Output(ResultsTable, RowResultsTableCrntMax, Sequence) 
     End If 
     Else 
     ' Value is non-numeric so cannot be a row number 
     Sequence(UBound(Sequence)) = "Non-numeric" 
     Call Output(ResultsTable, RowResultsTableCrntMax, Sequence) 
     End If 
     ' Restore Sequence ready for next column of DataTable 
     Sequence(InxSequenceMax) = "" 
     Sequence(UBound(Sequence)) = "" 
     InxSequenceMax = InxSequenceMax - 1 
    End If 
    Next 

End Sub 
Sub Output(ByRef ResultsTable As Variant, ByRef RowResultsTableCrntMax As Variant, _ 
      ByRef Sequence As Variant) 

    ' Copy contents of Sequence to next available row in ResultsTable 

    Dim InxSequenceCrnt As Long 

    RowResultsTableCrntMax = RowResultsTableCrntMax + 1 
    If RowResultsTableCrntMax > UBound(ResultsTable, 1) Then 
    ' Results Table is full 
    Exit Sub 
    End If 

    For InxSequenceCrnt = 1 To UBound(Sequence) 
    ResultsTable(RowResultsTableCrntMax, InxSequenceCrnt) = Sequence(InxSequenceCrnt) 
    Debug.Print " " & Sequence(InxSequenceCrnt); 
    Next 
    Debug.Print 

End Sub 


Sub TestLoadDataTable() 

    ' Call LoadTableTable then output its contents to the Immediate Window 

    Dim ColDTCrnt As Long 
    Dim DataTable As Variant 
    Dim RowDTCrnt As Long 

    Call LoadDataTable(DataTable) 

    ' Output header row for DataTable 
    Debug.Print "Row"; 
    For ColDTCrnt = 1 To UBound(DataTable, 2) 
    Debug.Print " Col" & Right("0" & ColDTCrnt, 2); 
    Next 
    Debug.Print 
    ' Output DataTable 
    For RowDTCrnt = 1 To UBound(DataTable, 1) 
    Debug.Print Right(" " & RowDTCrnt - 1, 3); 
    For ColDTCrnt = 1 To UBound(DataTable, 2) 
     Debug.Print " " & Right(" " & DataTable(RowDTCrnt, ColDTCrnt), 5); 
    Next 
    Debug.Print 
    Next 

End Sub 
Sub LoadDataTable(ByRef DataTable As Variant) 

    ' Determine the size of the Data Table and load its contents to DataTable 

    Dim ColDataTableRight As Long 
    Dim RowDataTableBottom As Long 

    With Worksheets(WshtName) 

    ' * You have a header for the Data Table: Col1|Col2|Col3| . . . 
    ' * This statement relies on there being a header. It does not matter what the header 
    ' values providing the header is complete. This is the equivalent to positioning the 
    ' cursor to the left cell of the header row and clicking Right. Since the start cell 
    ' contains a value, it moves to the cell before the next empty cell 
    ColDataTableRight = .Cells(RowWshtDataTableHdr, ColWshtDataTableLeft).End(xlToRight).Column 

    ' This statement first defines a range which is the width of the Data Table but includes 
    ' all rows of the worksheet. It then searches from row 1 backwards (that is it starts 
    ' the bottom row and searches upwards) until it finds a row with a value. This is the 
    ' last row of the Data Table 
    RowDataTableBottom = .Range(.Cells(1, ColWshtDataTableLeft), _ 
           .Cells(Rows.Count, ColDataTableRight)) _ 
          .Find("*", .Cells(1, ColWshtDataTableLeft), xlFormulas, , xlByRows, xlPrevious).Row 

    ' Import data table to DataTable 
    DataTable = .Range(.Cells(RowWshtDataTableHdr + 1, ColWshtDataTableLeft), _ 
         .Cells(RowDataTableBottom, ColDataTableRight)).Value 

    End With 

End Sub 
Function ColNumToCode(ByVal ColNum As Long) As String 

    Dim ColCode As String 
    Dim PartNum As Long 

    ' Last updated 3 Feb 12. Adapted to handle three character codes. 

    If ColNum = 0 Then 
    ColNumToCode = "0" 
    Else 
    ColCode = "" 
    Do While ColNum > 0 
     PartNum = (ColNum - 1) Mod 26 
     ColCode = Chr(65 + PartNum) & ColCode 
     ColNum = (ColNum - PartNum - 1) \ 26 
    Loop 
    End If 

    ColNumToCode = ColCode 

End Function