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

Question

我正在尝试建立一个风险计算矩阵。因此，当识别风险时，该风险对每种类型都有一个类别。根据图片，有 7 种不同的类型和 20 个不同的类：

每个班级都有不同的权重。

因此，例如，名为 riskA 的风险定义为：

1. 战略
2. 比20大
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

输入：

输出：

稍后我将添加进一步的解释，现在我只是评论了这些功能。为了使它工作，您需要在第一个工作表的 Col A:B 中拥有标签和在 Col C 中的数据。用 空 行分隔类很重要，数据从 第 1 行 开始，而不是第 2 行，因此上面没有标签。然后它会将组合输出到工作表 2 中，其中包含您在图片中看到的值和组合。如果您遵循输入要求，则函数的布局可以使用任何值。这也意味着您可以删除和添加类别。