私の Excel ワークシートでは、ユーザーは最小値、最大値、およびステップ サイズの値の形式で 1 ～ 5 行のデータを入力できます。データのすべての組み合わせを持つ多次元配列を作成したいと考えています。
これを VBA でコーディングして、配列のサイズを動的に変更し、データ項目の数を事前に知らなくてもセル値をループする方法はありますか?
3 行の入力のサンプル データ (これより多くても少なくてもかまいません)
Min, Max, Step
データ 1: 1、10、1
データ 2: 10、50、10
データ 3: 5、25、5
合計組み合わせは 250 (10 x 5 x 5)
コンボ 1: 1、10、5
コンボ 2: 1、10、10
コンボ 3: 1、10、15
...
ありがとう！
あなたの質問が少し不明確であることがわかりましたが、以下のマクロはあなたが望むことをしていると思います.
バリアントの Result がある場合は、Result を配列に設定できます。次に、Result(1)、Result(1)(1)、Result(1)(1)(1) などをネストされた配列に設定できます。適切な再帰ルーチンを使用すると、Excel の制限内で任意のサイズの配列を作成できると思います。しかし、このアプローチは非常に理解しにくいと思います。
可変次元の配列を作成するより簡単な方法があるとは思いません。ただし、寸法のサイズを変更しても問題ありません。
最大で 5 つの次元があるため、幅が 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)
最初の 3 つの次元には 10 個、5 個、5 個の要素があり、値の範囲を保持する準備ができています。最後の 2 つの次元は単なるプレースホルダーです。
ユーザーにディメンションの詳細を入力してもらいます。ワークシート「Dyn Dims」から詳細をロードしました。あなたの例に一致するテストでは、このワークシートを次のように設定します。
Min Max Step
1 10 1
10 50 10
5 25 5
この情報を長い配列 Requirements(1 から 3、1 から 5) に読み込みます。列は、最小、最大、およびステップです。行には、最大 5 つのディメンションを使用できます。列 3 (ステップ) がゼロの場合、ディメンションは使用されません。負のステップ値は許可しませんが、必要に応じて変更が必要な場所を示します。
ユーザーが入力したデータからこの配列を初期化する必要があります。
配列要件から、マクロは各次元の要素数を計算します。この計算を 1 ステップ 2 から 10 などの値でテストしましたが、最小 + N * ステップ = 最大のような N の値はありません。
次に、マクロは、必要に応じて配列 Result をディメンション化します。
配列内で必要な値を指定しないため、"N:N:N" の形式の値に設定しました。ここで、N は 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