AW: Makro für Permutation
06.08.2012 19:56:07
ransi
HAllo
So dahingeschrieben...
Versuch mal:
Option Explicit
Dim Out As Variant
Dim lngCount As Long
Public Sub prcMachs()
Dim sText As String
Dim nullText As String
Redim alle(0)
Dim I As Integer, K As Integer
lngCount = 0
sText = "1234"
Dim Z
Redim arr(Len(sText) - 1)
For I = 1 To Len(sText)
arr(I - 1) = Mid(sText, I, 1)
Next
Redim Out(WorksheetFunction.Fact(Len(sText)) - 1, 1 To 1)
Call fncPermut(arr, 0, Len(sText) - 1)
For I = LBound(Out) To UBound(Out)
For K = 1 To 5
Redim Preserve alle(Z)
alle(Z) = Format(machs(Out(I, 1), K), "00000000")
Z = Z + 1
Next
Next
Range("A1").Resize(Z, 1) = WorksheetFunction.Transpose(alle)
End Sub
Public Function fncPermut(ByVal arr, intCounter As Integer, intI As Integer)
Dim I As Integer
Dim vntTmp As Variant
If intCounter = intI Then
Out(lngCount, 1) = Join(arr, "")
lngCount = lngCount + 1
Else
For I = intCounter To intI
vntTmp = arr(I)
arr(I) = arr(intCounter)
arr(intCounter) = vntTmp
Call fncPermut(arr, intCounter + 1, intI)
Next
End If
End Function
Function machs(wert, zahl) As String
Dim txt As String
txt = "00000000"
Mid(txt, zahl, 4) = wert
machs = txt
End Function
ransi