小介绍：
我有一组元素需要组合以获得所有排列。给定这些排列的一些额外规则，我已经编写了一个轻量级递归过程来生成所有这些排列，到目前为止，我对这个过程的速度还不错。
问题：
一组元素的“排列”如下：每个数字只允许一次，除了允许所有可能的组合之外
Elements: 1a, 1b, 1c, 2a, 2b, 3a, 3b, 3c, 5a, 5b
Bundles of connections:
1a-2a-3a-5a
1a-2a-3a-5b
1a-2a-3b-5a
1a-2a-3b-5b
1a-2a-3c-5a
1a-2a-3c-5b
1a-2b-3a-5a
1a-2b-3a-5b
...
对于每个排列，我想计算一个分数，该分数由单个组合中的所有相邻连接定义。例如：
score(1a-3c-15g-4e-2a) = connection(1a-3c)
+ connection(3c-15g)
+ connection(15g-4e)
+ connection(4e-2a)
所有单独的连接都以表格的形式给出，如Excel中的工作表，顶部和左侧的行包含单个元素。连接值以范围的形式给出。
排列的数量可以用2*x^（x 1）近似，x最多允许15个。
可以想象，大量的排列需要一个非常有效的算法来在合理的时间内计算它。到目前为止，我可以在3分钟内管理x=8，在一小时内管理x=9。但是x=10需要一整天。
到目前为止我的方法：
我的第一直觉是一次查看每个排列，过滤掉每个连接并使用以下代码片段：
Dim pos1 as Long
Dim pos2 as Long
'k_D : array of all elements (from leftmost column where all connections are stored)
'eg: 1a, 1b, 1c, 2a, 2b, 3a, 3b, 3c, 3d, ... 15f, 15g
pos1 = CLng(Application.WorksheetFunction.Match(current_first, k_D, 0))'position of first element
pos2 = CLng(Application.WorksheetFunction.Match(current_last, k_D, 0)) 'position of second element
有了这个，我可以简单地通过单元格引用来解决所需的连接。
这是我到目前为止最快的一次！
其他方法包括创建某种具有所有连接和所有值的查找数组，以将其减少到仅调用一次MATCH。这要慢得多——我假设对大小为n的数组进行2次调用比对大小为n^2的数组进行1次调用快。
我所做的大多数其他更改都处理了代码的其他部分，这些部分从未真正改变过任何东西。MATCH函数似乎是我方法中的真正瓶颈。
我希望一双新的眼睛能给我一些新的想法。
更新2020_09_30-13:30正如所问：我关于如何获得每个包的分数的实现。
Function getConsistency(current_buendel As String)
'This function takes a bundle like "1a-2a-3a" und sums up all given entries.
Dim i1, i2, i3 As Integer
Dim pos1 As Long
Dim pos2 As Long
Dim sum, sum_temp As Integer
Dim current_connection, current_first, current_last As String
Dim connections As Integer
connections = 0
Dim i As Integer
Dim elem As Variant
sum = 0
Dim counter
counter = 0
connections = UBound(Split(current_bundle, "-"))
Do
'At first the current_bundle is cut into two pieces
'eg 1a-2a-3a-4a -> 1a-2a and 2a-3a-4a
'find first '-'
i1 = InStr(1, current_bundle, "-", vbTextCompare)
'find second '-'
i2 = InStr(i1 + 1, current_bundle, "-", vbTextCompare)
'split current_bundle in two parts
If i2 > 0 Then
current_connection = Left(current_bundle, i2 - 1)
current_bundle = Right(current_bundle, Len(current_bundle) - i1)
Else
current_connection = current_bundle
End If
'work on current connection
' Split in two parts
'eg 1a-2a -> 1a and 2a
i3 = InStr(1, current_connection, "-", vbTextCompare)
current_first = Left(current_connection, i3 - 1)
current_last = Right(current_connection, Len(current_connection) - i3)
'get vertical positions of those projections
pos1 = CLng(Application.WorksheetFunction.Match(current_first, k_D, 0))
pos2 = CLng(Application.WorksheetFunction.Match(current_last, k_D, 0))
'Handle results
'This can be done, since the entries in k_ALL2 are lower diagonal
'shift pos1 and pos2 according to where the matrix is located
If pos1 < pos2 Then
sum_temp = k_ALL2(pos2, pos1 + 1)
Else
sum_temp = k_ALL2(pos1, pos2 + 1)
End If
sum = sum + sum_temp
Loop While i2 > 0
getConsistency = Array(sum, sum / connections, counter)
End Function
通过尽可能少地触摸电子表格可以获得最大的加速。创建一个全局字典，将"2c"等字符串与值中的索引相关联，并将这些值本身存储在一个全局数组中。如果您正在循环大量捆绑包，初始化代码将只运行一次：
Option Explicit
'module-level variables:
Dim index As Variant
Dim connections As Variant
Dim initialized As Boolean
Sub Initialize()
initialized = True
Dim i As Long, n As Long
Set index = CreateObject("Scripting.Dictionary")
index.CompareMode = 1
With Range("k_D")
n = .Cells.Count
For i = 1 To n
index.Add .Cells(i).Value, i
Next i
End With
connections = Range("K_ALL2").Value
End Sub
Function getConsistency(current_bundle As String) As Variant
'This function takes a bundle like "1a-2a-3a" und sums up all given entries.
Dim i As Long, r As Long, c As Long
Dim sum As Variant, terms As Variant
If Not initialized Then Initialize
terms = Split(current_bundle, "-")
sum = 0
For i = 0 To UBound(terms) - 1
r = index(Trim(terms(i)))
c = index(Trim(terms(i + 1)))
If r > c Then
sum = sum + connections(r, c)
Else
sum = sum + connections(c, r)
End If
Next i
getConsistency = sum
End Function
