Hi Dennis,

der wichtigste Schritt wäre die Permutationen erst mal alle generieren zu können.

Dazu kann man sich z.B. eine Klasse schreiben:

'//////////////////////////////////////////////////////////
'// Klasse: CPermutation
'//////////////////////////////////////////////////////////
Option Explicit

'#####################################################################################

Private Const C_ERR_INVALID_ARGUMENT As Long = 5&

'#####################################################################################

Dim m_avdblCurrentPerm As Variant ' aktuelle Permutation (ggf. gleich Empty)
Dim m_dblCount As Double          ' Anzahl der Elemente

'#####################################################################################
'## PRIVATE (Konstruktor / Destruktor)
'#####################################################################################

Private Sub Class_Initialize()
  m_avdblCurrentPerm = Empty
  m_dblCount = 0
End Sub

Private Sub Class_Terminate()
  On Error Resume Next
  Erase m_avdblCurrentPerm
End Sub

'#####################################################################################
'## PUBLIC
'#####################################################################################

'//////////////////////////////////////////////////////////
'// aktuelle Permutation (ggf. gleich Empty)
Public Property Get Current() As Variant
  Current = m_avdblCurrentPerm
End Property

'//////////////////////////////////////////////////////////
'// Erste Permutation
Public Sub Init(ByVal n As Double)
  
  If n < 1 Then
    Err.Raise C_ERR_INVALID_ARGUMENT
    Exit Sub
  End If
  
  Dim i As Double
  
  ReDim m_avdblCurrentPerm(0 To n - 1) As Double
  m_dblCount = n
  
  For i = 0 To n - 1
    m_avdblCurrentPerm(i) = i
  Next
  
End Sub

'//////////////////////////////////////////////////////////
'// nächste Permutation
Public Function MoveNext() As Boolean
  
  If IsEmpty(m_avdblCurrentPerm) Then
    Me.Init m_dblCount
    Exit Function
  End If
  
  Dim i#, j#
  
  For i = m_dblCount - 2 To 0 Step -1
    ' linker Index kleiner als der rechte Index?
    If m_avdblCurrentPerm(i) < m_avdblCurrentPerm(i + 1) Then Exit For
  Next
  If i < 0 Then
    ' keine Permutation mehr möglich
    Erase m_avdblCurrentPerm
    m_avdblCurrentPerm = Empty
    MoveNext = False
    Exit Function
  End If
  
  For j = m_dblCount - 1 To 0 Step -1
    ' rechter Index größer als der linke Index ?
    If m_avdblCurrentPerm(j) > m_avdblCurrentPerm(i) Then Exit For
  Next
  
  Call Swap(i, j)
  Call Reverse(i + 1, m_dblCount - 1)
  
  MoveNext = True
  
End Function

'//////////////////////////////////////////////////////////
'// Permutation als Zeichenkette
Public Function ToString() As String
  
  Dim i#
  
  If Not IsEmpty(m_avdblCurrentPerm) Then
    For i = 0 To m_dblCount - 1
      ToString = ToString & IIf(ToString <> "", " ", "") & m_avdblCurrentPerm(i)
    Next
  Else
    ToString = "<EOP>"
  End If
  
End Function

'#####################################################################################
'## PRIVATE (Hilfsfunktionen)
'#####################################################################################

'//////////////////////////////////////////////////////////
'// Vertauscht zwei Elemente miteinander
Private Sub Swap(Idx1 As Double, Idx2 As Double)
  Dim t As Double
  t = m_avdblCurrentPerm(Idx1)
  m_avdblCurrentPerm(Idx1) = m_avdblCurrentPerm(Idx2)
  m_avdblCurrentPerm(Idx2) = t
End Sub

'//////////////////////////////////////////////////////////
'// Kehrt die Reihenfolge von Elementen um
'// (Bereich wählbar)
Private Sub Reverse(StartIdx As Double, EndIdx As Double)
  
  Dim i#, j#
  Dim t#
  
  i = StartIdx
  j = EndIdx
  
  While i < j
    t = m_avdblCurrentPerm(i)
    m_avdblCurrentPerm(i) = m_avdblCurrentPerm(j)
    m_avdblCurrentPerm(j) = t
    i = i + 1
    j = j - 1
  Wend
  
End Sub

Mit Double kann man z.B. mit bis zu 170 Elementen arbeiten (Pi mal Daumen).

Beispiel sähe dann so aus:

' in einem Modul
Option Explicit

Sub testaufruf()
  
  Dim o As CPermutation
  Dim c() As Double
  Dim n As Double
  
  Set o = New CPermutation
  o.Init 4 '4 Elemente = 4! = 4*3*2*1 = 24 Permutationen
  
  Do
    n = n + 1 ' Anzahl der Permutationen mitzählen
    
    ' aktuelle Permutation
    'c = o.Current
    
    ' Ausgabe der aktuellen Permutation (sollte mit 9 Elementen oder mehr nicht mehr ausgeführt werden)
    Debug.Print "[" & Format$(n, "000") & "] >> " & o.ToString
    
  Loop While o.MoveNext
  Debug.Print "Total: " & Format$(n, "#,##0")
  
  Set o = Nothing
  
End Sub

Der nächste Schritt besteht dann darin für jede Kombination die Wegstrecke zu berechnen (Variable c). Von Permutation zu Permutation merkt man sich die kürzeste Weglänge und natürlich die entsprechende Permutation dazu.

Mit 10 Elementen (Bohrungen) wird das vorraussichtlich nen merkbares Weilchen an Rechenzeit beanspruchen. ;)

Gruß, Trägheit