我發現你的問題有點不清楚,但我相信下面的宏就是你想要的。
如果您有一個變體Result,您可以將Result設置爲一個數組。然後,您可以依次將Result(1),Result(1)(1),Result(1)(1)(1)等設置爲嵌套數組。有了合適的遞歸例程,我相信你可以在限制Excel中創建你想要的任何大小的數組。但是,我認爲這種方法很難理解。
我不相信有一個更簡單的方法來創建一個可變數量的維數組。然而,改變尺寸的大小不是問題。
由於您最多有五個維度,因此我決定使用固定數量的維度,其中包含寬度爲1的尾隨未使用維度。與您的示例(1到10的步驟1中,10〜50步驟10中,5至25的步驟5),這將需要:
Dim Result(1 To 10, 1 To 5, 1 To 5, 1 To 1, 1 To 1)
前三個維度具有10 5和5的元件,準備保持值的範圍。最後的兩個維度只是佔位符。
您正在讓用戶輸入尺寸詳細信息。我已經從工作表「Dyn Dims」中加載了詳細信息。對於你的例子相匹配的測試,我設置此工作表:
Min Max Step
1 10 1
10 50 10
5 25 5
我加載該信息來多頭排列要求(1〜3個,1〜5)。列是最小值,最大值和步長。這些行允許最多五個維度。如果第3列(步驟)爲零,則不使用該維度。我不允許使用負面的步驟值,但指出在需要時需要進行更改的地方。
您需要從用戶輸入的數據中初始化此數組。
從數組要求中,宏計算每個維度中的元素數量。我已經用這個值來測試這個計算,例如1步2到10,其中N沒有值,使得Min + N * Step = Max。
宏然後維度數組結果根據需要。
您不需要在數組中指定想要的值,因此我將它們設置爲「N:N:N」形式的值,其中Ns是Min-To-Max-Step計算中的值。我已經在宏中解釋過這一點,在此不再重複。
最後,我將數組的內容輸出到一個爲日期和時間命名的文件。有了您的例子輸出爲:
Dimensions
1 2 3 Value
1 1 1 1:10:5
2 1 1 2:10:5
3 1 1 3:10:5
4 1 1 4:10:5
5 1 1 5:10:5
6 1 1 6:10:5
7 1 1 7:10:5
8 1 1 8:10:5
9 1 1 9:10:5
10 1 1 10:10:5
1 2 1 1:20:5
: : : :
5 5 5 5:50:25
6 5 5 6:50:25
7 5 5 7:50:25
8 5 5 8:50:25
9 5 5 9:50:25
10 5 5 10:50:25
我相信我已經包含了足夠的註釋來解釋宏,但如果有必要的問題回來。
Option Explicit
Sub DD()
Const ColReqMin As Long = 1
Const ColReqMax As Long = 2
Const ColReqStep As Long = 3
Dim DimCrnt As Long
Dim Entry(1 To 5) As Long
Dim EntryStepped As Boolean
Dim FileOutNum As Long
Dim Index(1 To 5) As Long
Dim IndexStepped As Boolean
Dim NumEntries(1 To 5) As Long
Dim Requirements(1 To 3, 1 To 5) As Long
Dim Result() As String
Dim RowDDCrnt As Long
Dim Stg As String
Dim Value As String
' Load Requirements with the required ranges
With Worksheets("Dyn Dims")
RowDDCrnt = 2 ' First data row of worksheet Dyn Dims
' Note this macro does not check for blank lines in the middle
' of the table.
For DimCrnt = 1 To 5
If IsEmpty(.Cells(RowDDCrnt, ColReqStep)) Then
' No step value so this dimension not required for this run
Requirements(ColReqStep, DimCrnt) = 0
Else
Requirements(ColReqMin, DimCrnt) = .Cells(RowDDCrnt, ColReqMin)
Requirements(ColReqMax, DimCrnt) = .Cells(RowDDCrnt, ColReqMax)
Requirements(ColReqStep, DimCrnt) = .Cells(RowDDCrnt, ColReqStep)
End If
RowDDCrnt = RowDDCrnt + 1
Next
End With
' Calculate number of entries for each dimension
For DimCrnt = 1 To 5
If Requirements(ColReqStep, DimCrnt) = 0 Then
' Dummy dimension
NumEntries(DimCrnt) = 1
Else
NumEntries(DimCrnt) = (Requirements(ColReqMax, DimCrnt) - _
Requirements(ColReqMin, DimCrnt) + _
Requirements(ColReqStep, DimCrnt)) \ _
Requirements(ColReqStep, DimCrnt)
End If
Next
' Size array
ReDim Result(1 To NumEntries(1), _
1 To NumEntries(2), _
1 To NumEntries(3), _
1 To NumEntries(4), _
1 To NumEntries(5))
' Initialise entry for each dimension to minimum value, if any,
' and index for each dimension to 1
For DimCrnt = 1 To 5
Index(DimCrnt) = 1
If Requirements(ColReqStep, DimCrnt) <> 0 Then
Entry(DimCrnt) = Requirements(ColReqMin, DimCrnt)
End If
Next
' Starting with Entry(1), this loop steps the entry if the dimension is used.
' If the stepped entry is not greater than the maximum, then this repeat of
' the loop has finished. If the stepped entry is greater than the maximum,
' it is reset to its minimum and the next entry stepped and checked in the
' same way. If no entry is found that can be stepped, the loop is finished.
' If the dimensions after all 1 to 3 step 1, the values created by this loop
' are:
' 1 1 1 1 1
' 2 1 1 1 1
' 3 1 1 1 1
' 1 2 1 1 1
' 2 2 1 1 1
' 3 2 1 1 1
' 1 3 1 1 1
' 2 3 1 1 1
' 3 3 1 1 1
' 1 1 2 1 1
' 2 1 2 1 1
' 3 1 2 1 1
' : : : : :
' 3 3 3 3 3
Do While True
' Concatenate entries to create value for initial element
' or for element identified by last loop
Value = Entry(1)
For DimCrnt = 2 To 5
If Requirements(ColReqStep, DimCrnt) = 0 Then
Exit For
End If
Value = Value & ":" & Entry(DimCrnt)
Next
Result(Index(1), Index(2), Index(3), Index(4), Index(5)) = Value
' Find an entry to step
EntryStepped = False
For DimCrnt = 1 To 5
If Requirements(ColReqStep, DimCrnt) = 0 Then
Exit For
End If
Index(DimCrnt) = Index(DimCrnt) + 1
Entry(DimCrnt) = Entry(DimCrnt) + _
Requirements(ColReqStep, DimCrnt)
' ### Changes required her if a negative step value is allow
If Entry(DimCrnt) <= Requirements(ColReqMax, DimCrnt) Then
' This stepped entry is within permitted range
EntryStepped = True
Exit For
End If
' This entry past its maximum so reset to minimum
' and let for loop step entry for next dimension
Index(DimCrnt) = 1
Entry(DimCrnt) = Requirements(ColReqMin, DimCrnt)
Next
If Not EntryStepped Then
' All elements of Result initialised
Exit Do
End If
Loop
' All elements of Result initialised
' Output values as test.
FileOutNum = FreeFile
Open ActiveWorkbook.Path & "\" & Format(Now(), "yymmdd hhmmss") & ".txt" _
For Output As #FileOutNum
' Initialise Index
For DimCrnt = 1 To 5
Index(DimCrnt) = 1
Next
' Create header line for table
Print #FileOutNum, "Dimensions"
Stg = ""
For DimCrnt = 1 To 5
If Requirements(ColReqStep, DimCrnt) = 0 Then
Exit For
End If
Stg = Stg & Right(" " & DimCrnt, 4)
Next
Stg = Stg & " Value"
Print #FileOutNum, Stg
' Similar logic to loop that intialised Result but using Index and UBound.
Do While True
' Output initial element or element identified by previous loop
Stg = ""
For DimCrnt = 1 To 5
If Requirements(ColReqStep, DimCrnt) = 0 Then
Exit For
End If
Stg = Stg & Right(" " & Index(DimCrnt), 4)
Next
Stg = Stg & " " & Result(Index(1), Index(2), Index(3), Index(4), Index(5))
Print #FileOutNum, Stg
' Identify next element, if any
IndexStepped = False
For DimCrnt = 1 To 5
If Requirements(ColReqStep, DimCrnt) = 0 Then
Exit For
End If
Index(DimCrnt) = Index(DimCrnt) + 1
If Index(DimCrnt) <= UBound(Result, DimCrnt) Then
IndexStepped = True
Exit For
Else
Index(DimCrnt) = 1
End If
Next
If Not IndexStepped Then
' All entries output
Exit Do
End If
Loop
Close #FileOutNum
End Sub
你可以使用 「REDIM保留」 爲這裏討論:http://stackoverflow.com/questions/2916009/vba-what-does-redim-preserve-do-and-simple-array-question –
當你說「我想創建一個多維數組」 - 你的意思是說,在你的情況下,數組是(250 x 3)或(10 x 5 x 5 x 3)?你想要在VBA數組中生成值(供其他VBA代碼使用)還是將其放置在工作表的某個位置? – Floris
我的回答是否符合您的需求?如果不是,爲什麼不呢?你的個人資料說你正在訪問堆棧溢出,但你還沒有確認我的答案。 –