2013-06-20 22 views
0

在我的Excel工作表中,用戶可以以最小值,最大值和步長值的形式輸入1到5行數據。我想創建一個具有所有數據組合的多維數組。如何在數組中填入數字的動態組合

有沒有一種方法可以在VBA中對此進行編碼,以動態調整數組大小並循環訪問單元格值,而無需事先知道多少數據項?

的輸入3行實施例的數據(可以是更多或更少)

 Min, Max, Step 

數據1:1,10,1

數據2:10,50,10

數據3:5,25,5個

總組合是250(10×5×5)

組合1:1,10,5

組合2:1,10,10

組合3:1,10,15

...

謝謝!

+0

你可以使用 「REDIM保留」 爲這裏討論:http://stackoverflow.com/questions/2916009/vba-what-does-redim-preserve-do-and-simple-array-question –

+0

當你說「我想創建一個多維數組」 - 你的意思是說,在你的情況下,數組是(250 x 3)或(10 x 5 x 5 x 3)?你想要在VBA數組中生成值(供其他VBA代碼使用)還是將其放置在工作表的某個位置? – Floris

+0

我的回答是否符合您的需求?如果不是,爲什麼不呢?你的個人資料說你正在訪問堆棧溢出,但你還沒有確認我的答案。 –

回答

0

我發現你的問題有點不清楚,但我相信下面的宏就是你想要的。

如果您有一個變體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 
+0

謝謝託尼。這很棒!!!我必須仔細查看以確保我理解它。我認爲我可以適應它以適應我的需求。我想通過「輸入次數」將組合保存到「組合數」數組中。對於這個例子,它將是數組(1到250,1到3)。 – Jason

+0

如果一個數組(1到250,1到3)足以滿足您的需求,那麼我誤解了您所尋求的。您的問題意味着每個輸入需要一個維度,而維度的大小是針對輸入的。 –