具有多个选项和不同权重的排列

我正在尝试build立一个风险计算matrix。 所以，当一个风险被识别时，这个风险对于每一个types都有一个等级。 根据图像，有7种不同的types和20种不同的类别：

每个class级都有不同的重量。

所以，举例来说，一个名为riskA的风险被定义为：

1. 战略
2. biggerThan20
3. 商业
4. 是
5. 是
6. 是
7. 是

然后，这些组合将具有重量=（10 + 30 + 20 + 70 + 40 + 60 + 50）重量= 280

我需要知道每个可能的计算组合。 我相信960个组合。 我试图运行一些javaScript代码来获得结果没有成功。 我不能想到使用Excel的简单方法。

具有可能值的电子表格的图像：

Answer 1

所以试试这个：

Sub Posibilities() Dim sht As Worksheet, sht2 As Worksheet Dim lRow As Long, Bound As Long Dim Out As Variant, lOut As Variant, Values As Variant, Delimiter As Variant, Label As Variant Set sht = Worksheets(1) Set sht2 = Worksheets(2) With sht lRow = .Cells(.Rows.Count, 3).End(xlUp).Row Values = .Range("C1:C" & lRow + 1) Label = .Range("A1:B" & lRow) End With Values = OneDimension(Values) Label = Labeling(Label) Delimiter = SubArrays(Values) Out = CalculateArrays(SliceArray(Values, 1, Delimiter(0) - 1), SliceArray(Values, Delimiter(0) + 1, Delimiter(1) - 1), 1) lOut = CalculateArrays(SliceArray(Label, 1, Delimiter(0) - 1), SliceArray(Label, Delimiter(0) + 1, Delimiter(1) - 1), 2) For i = 1 To UBound(Delimiter) - 1 Out = CalculateArrays(Out, SliceArray(Values, Delimiter(i) + 1, Delimiter(i + 1) - 1), 1) lOut = CalculateArrays(lOut, SliceArray(Label, Delimiter(i) + 1, Delimiter(i + 1) - 1), 2) Next i 'Output into Sheet(2) For i = 1 To UBound(Out) sht2.Cells(i, 1).Value = Out(i) sht2.Cells(i, 2).Value = lOut(i) Next i sht2.Columns.AutoFit End Sub Function CalculateArrays(arr1 As Variant, arr2 As Variant, Mode As Integer) As Variant 'Input: 2 One-Dimensional Arrays, Mode(1 for Values, 2 for String to Add Delimiter) 'Adds Values of arr1 and arr2 'Output: One-Dimensional Array arr3 with all Combinations Dim arr3() As Variant, Counter As Long: Counter = 1 Dim Elements1 As Long, Elements2 As Long Elements1 = UBound(arr1) - LBound(arr1) + 1 Elements2 = UBound(arr2) - LBound(arr2) + 1 ReDim arr3(1 To Elements1 * Elements2) For i = LBound(arr1) To UBound(arr1) For j = LBound(arr2) To UBound(arr2) Select Case Mode Case 1 arr3(Counter) = arr1(i) + arr2(j) Case 2 arr3(Counter) = arr1(i) & "|" & arr2(j) End Select Counter = Counter + 1 Next j Next i CalculateArrays = arr3 End Function Function SubArrays(arr1 As Variant) As Variant 'Input: One-Dimensional Array with empty Elements 'Searches for "" in arr1 (fields with no values in col c) 'Output: One-Dimensonal Array with Index of empty Fields Dim arr2() As Variant, Count As Long: Count = 0 For i = 1 To UBound(arr1) If arr1(i) = "" Then ReDim Preserve arr2(Count) arr2(Count) = i Count = Count + 1 End If Next i SubArrays = arr2 End Function Function OneDimension(arr1 As Variant) As Variant 'Input: 2-Dimensional Array 'Transforms first Dimension of 2-Dimensional-Array into 1-Dimensional Array 'Output: 1-Dimensional Array Dim arr2 As Variant ReDim arr2(LBound(arr1, 1) To UBound(arr1, 1)) For i = LBound(arr1, 1) To UBound(arr1, 1) arr2(i) = arr1(i, 1) Next i OneDimension = arr2 End Function Function SliceArray(arr1 As Variant, l As Integer, r As Integer) As Variant 'Input: 1-Dimensional Array, l as LeftBound, r As RightBound 'Output: 1-Dimensional Array from l to r Dim arr2 As Variant ReDim arr2(l To r) For i = l To r arr2(i) = arr1(i) Next i SliceArray = arr2 End Function Function Labeling(arr1 As Variant) As Variant 'Input: 2-Dimensional Array (Col A:B) 'Transforms Array into 1 -Dimension and adds Delimiter in between. 'Output: 1-Dimensional Array Dim arr2 As Variant ReDim arr2(1 To UBound(arr1, 1)) For i = 1 To UBound(arr1, 1) arr2(i) = arr1(i, 1) & ": " & arr1(i, 2) Next i Labeling = arr2 End Function 

input：

输出：

稍后我会再补充一些解释，现在我只说了一下function。 对于它的工作，你需要有第一个工作表中Col A:B的标签和Col C中的数据。 有一个空的 Row和Data分别开始在第一行 ，而不是2，所以没有上面的标签是重要的。 然后它将输出组合到工作表2的值和组合，你可以在图片中看到。 如果您遵循“input要求”，则该函数可用于处理任何值。 这也意味着你可以删除和添加类别。