Question

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

每个班级都有不同的分量。

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

战略
biggerThan20
业务
是
是
是
是

然后，这些的组合将具有权重=（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中，如图中所示。如果您遵循输入要求，则可以使用该函数处理任何值。这也意味着您可以删除并添加类别。

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

1 个答案: