VBA中的動態循環

Question

在VBA中相當新穎，我很感謝您對以下問題的幫助。

我想創建一個0和1的表。 我有一組變量讓我們稱它們爲A，B，C，它們可以分別取a，b，c不同值（a，b，c是整數）。 我正在嘗試構建這3個變量組合的所有不同場景的矩陣。在基質中的值將是0或1。 所以若a = 2，B = 3，C = 4，表將看起來像

我所編寫的代碼（在插入的結束）。

但是，表格必須是動態的，因爲變量數量（以及每個變量的場景數量）不是固定的。 有人可以幫我嗎？

謝謝

Sub table() 
For i = 1 To 2 
    For j = 1 To 3 
     For k = 1 To 4 
      For m = 1 To 9 
       If m = i Then 
        Worksheets("sheet1").Range("a1").Cells(12 * (i - 1) + 4 * (j - 1) + k, m).Value = 1 
       ElseIf m = j + 2 Then 
        Worksheets("sheet1").Range("a1").Cells(12 * (i - 1) + 4 * (j - 1) + k, m).Value = 1 
       ElseIf m = k + 5 Then 
        Worksheets("sheet1").Range("a1").Cells(12 * (i - 1) + 4 * (j - 1) + k, m).Value = 1 
       Else 
        Worksheets("sheet1").Range("a1").Cells(12 * (i - 1) + 4 * (j - 1) + k, m).Value = 0 
       End If 
      Next m 
     Next k 
    Next j 
Next i 
End Sub 

Answer 1

試試這個：

Sub matrix() 
Dim arr() As Variant 
Dim totrow As Long 
Dim j As Long 
Dim t As Long 
Dim p As Long 
Dim x As Long 
Dim ws As Worksheet 
Set ws = Sheets("Sheet1") 
'Set your array of numbers 
arr = Array(2, 3, 4) 
'If you want to refer to ranges on Sheet1 use: 
'arr = Array(ws.Range("T1"), ws.Range("U1"), ws.Range("V1")) 

totrow = 1 
For j = LBound(arr) To UBound(arr) 
    totrow = totrow * arr(j) 
    x = x + arr(j) 
Next j 
ws.Range(ws.Cells(1, 1), ws.Cells(totrow, x)).Value = 0 
p = 1 

For j = UBound(arr) To LBound(arr) Step -1 
    For t = 1 To totrow Step 1 
     For i = 1 To arr(j) 
      ws.Range(ws.Cells(t, x - arr(j) + i), ws.Cells(t + p - 1, x - arr(j) + i)).Value = 1 
      t = t + p 
     Next i 
     t = t - 1 
    Next t 
    p = p * arr(j) 
    x = x - arr(j) 
Next j 
End Sub 

這將數組中或任何價值的任何數量的數組中的整數的工作。主要限制是工作表上的行數和列數。