Anzeige
Archiv - Navigation
1176to1180
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Permutation

Permutation
alifa
Guten Morgen,
die Anzahl der Permutationen von 1333666666 ist 3628800(also 10!). Die meisten von diesen Zahlen sind mehrfach vorhanden. Wie kann ich erreichen, dass nur die 840 Permutationen ermittelt werden, die unterschiedliche Zahlen darstellen?
VG, Alifa

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Permutation
26.09.2010 11:00:58
ransi
HAllo Alifa
Schmeiss alle Permutationen nacheinander in ein Dictionary.
Das nimmt dann nur die Unikate.
ransi
AW: Permutation
26.09.2010 12:06:44
alifa
Hallo Daniel,
das Problem ist geteilt. Hier ist die Frage nur nach der Möglichkeit, mehrfache Eintragungen zu vermeiden.
Bei office geht es hauptsächlich um Primzahlen. Da steht etwas von" Dictionary", davon habe ich allerdings keine Ahnung!
Gruß, Alifa
Anzeige
AW: Makro Stopp
26.09.2010 12:36:58
Daniel
Hi
tja, da musst du nochmal ransi fragen.
seine Erklärungen sind oft etwas spärlich.
zum Verständnis von Dicitonaries.
die kann man sich im Prinzip als eindimensonale Arrays vorstellen, bei denen der Index durch einen beliebigen Freitext gebildet wird.
Der Vorteil ist, daß sich sich die Dictionarys selbst organisieren (also nicht mit DIM auf eine bestimmte grösse und Anzahl festgelegt werden) und in der Anwendung sehr schnell sind.
sowas ist für solche Aufgaben wie Ergebnis ohne Doppelte sehr hilfreich.
im Prinzip würde das so aussehen:
dim dictErgebnisOhneDoppelte as Object
dim arrErgebnisOhneDoppelte as Variant
set dictErgebnisOhneDoppelte as CreateObject("Scriping.Dictionary")
For ... 'hier beginnt die Schleife zur Erstellung der Permutationen
Permutation = ....
dictErgebnisOhneDoppelte(Permutation)=0
Next
arrErgebnisOhneDoppelte = dictErgebnisOhneDoppelte.Keys
mit .Keys lassen sich die Indexe des Dicionarys abfragen.
die Variable arrErgebnisOhneDoppelte ist jetzt ein normales eindimensonales Array, daß alle Permutationen ohne Doppelte enthält.
Gruß, Daniel
Anzeige
222 Möglichkeiten ?
26.09.2010 13:20:52
ransi
Hallo Alifa
Ausgehend von Erqus Forderung:
'suche eine 10-stellige Primzahl.Jede Ziffer
'ist so oft vorhanden, wie ihr Wert.Beispiel:3666366613

Erstmal etwas Vorarbeit.
Das sind die Zahlen aus deren Permutationen so etwas gemacht werden kann:
9999999991
8888888822
7777777333
7777777221
6666664444
6666663331
5555544441
5555533322
4444333221

Wobei 6666664444 und 8888888822 rausfallen weil die immer durch 2 teilbar sind.
Jetzt mal diesen Code:
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Dim myDic As Object

Public Sub test()
Dim arr As Variant
Dim i As Integer
Dim L As Long
Dim Ding
Dim objItems
Redim out(L)
arr = Array(9999999991#, 7777777333#, 7777777221#, 6666663331#, 5555544441#, 5555533322#, 4444333221#)
Set myDic = CreateObject("Scripting.dictionary")
For i = LBound(arr) To UBound(arr)
    myDic.removeall 'Dictionary leeren
    Textdreher "", arr(i)
    objItems = myDic.keys
    For Each Ding In objItems
        If primzahltest(Ding) Then
            Redim Preserve out(L) 'Ausgabearray neu dimensionieren
            out(L) = Ding
            L = L + 1
        End If
    Next
Next
'Ausgeben
Range("A1").Resize(UBound(out) + 1) = WorksheetFunction.Transpose(out)
End Sub



Public Sub Textdreher(x As String, ByVal y As String)
'http://www.schmittis-page.de/excel/vba/t26.htm
Dim i As Integer, j As Integer
j = Len(y)
If j < 2 Then
    ' Zeile = Zeile + 1
    myDic(x & y) = 0 'Permutationen ohne Duplicate ins Dictionary
Else
    For i = 1 To j
        Call Textdreher(x + Mid(y, i, 1), _
            Left(y, i - 1) + Right(y, j - i))
    Next
End If
End Sub




Public Function primzahltest(lngZahl) As Boolean
'bst
Dim i
If lngZahl > 4 Then
    If lngZahl / 2 = Int(lngZahl / 2) Then Exit Function ' Zahl ist durch 2 teilbar
    If lngZahl / 3 = Int(lngZahl / 3) Then Exit Function ' Zahl ist durch 3 teilbar
    ' von den Zahlen 6*n-1 bis 6*n+5 nur noch 6*n-1 und 6*n+1 testen da:
    ' 6*n, 6*n+2, 6*n+4 durch 2, 6*n+3 durch 3 teilbar ist
    ' und dieses bereits zuvor getestet wurde
    For i = 6 To Int(Sqr(lngZahl)) + 1 Step 6
        If lngZahl / (i - 1) = Int(lngZahl / (i - 1)) Then Exit Function
        If lngZahl / (i + 1) = Int(lngZahl / (i + 1)) Then Exit Function
    Next
    primzahltest = True
Else ' es verbleiben die Zahlen <= 4, von denen sind nur 2 und 3 Primzahlen
    primzahltest = lngZahl = 2 Or lngZahl = 3
End If
End Function


Der Code braucht bei mir ca. 1 Minute.
ransi
Anzeige
AW: 222 Möglichkeiten ?
26.09.2010 18:42:27
alifa
Eigentlich hatte ich hier eine Frage betreff Permutationen gestellt, die ja auch zu meiner vollen Zufriedenheit beantwortet wurde. Ransi hat sogar die Primzahlen aus allen Möglichkeiten ermittelt. Das übertrifft meine Erwartung. Dieses Macro braucht bei mir ca 3 Minuten.
Danke, Alifa
ist wahrscheinlich nur Zufall ?
26.09.2010 12:12:45
WF
Hi,
eine 10-stellige Zahl mit 3 unterschiedlichen Ziffern:
=VARIATIONEN(10;3)+KOMBINATIONEN(10;3)
ergibt 840
Salut WF
AW: Permutation
26.09.2010 13:12:26
JogyB
Hallo Alifa,
der Code braucht ca. eine Minute und spuckt zumindest mal 840 Ergebnisse aus. Aber Vorsicht! Er lässt sich zwar auf mehr als 10 Stellen erweitern, dann ist aber das Problem, dass die Like-Prüfung bei einer im vorZaehler vorhandenen 10 auch eine 1 erkennt. Man müsste dann beim Aufbauf von vorZaehler noch Trennzeichen einbauen und die auch in die Like-Prüfung aufnehmen - das verlangsamt aber den Code um ca. 50%.
Dim zaHl(0 To 9) As Long
Dim myDict As Object
Sub Permutationen2()
zaHl(0) = 1
zaHl(1) = 3
zaHl(2) = 3
zaHl(3) = 3
zaHl(4) = 6
zaHl(5) = 6
zaHl(6) = 6
zaHl(7) = 6
zaHl(8) = 6
zaHl(9) = 6
Set myDict = CreateObject("Scripting.Dictionary")
Call erZeugeStelle("", 1, "")
Range("A1").Resize(myDict.Count) = WorksheetFunction.Transpose(myDict.keys)
End Sub
Sub erZeugeStelle(ByVal perMut As String, ByVal steLLe As Long, ByVal vorZaehler As String)
Dim stelleOK As Boolean
Dim zaeHler As Long
For zaeHler = 0 To 9
If Not vorZaehler Like "*" & zaeHler & "*" Then
If steLLe 

Gruß, Jogy
Anzeige
knapp doppelt so schnell...
26.09.2010 15:11:00
JogyB
... zumindest solange keine Trennzeichen notwendig sind:
Dim zaHl(0 To 9) As Long
Dim myDict As Object
Sub Permutationen2()
Dim tmr As Double
tmr = Timer
zaHl(0) = 1
zaHl(1) = 3
zaHl(2) = 3
zaHl(3) = 3
zaHl(4) = 6
zaHl(5) = 6
zaHl(6) = 6
zaHl(7) = 6
zaHl(8) = 6
zaHl(9) = 6
Set myDict = CreateObject("Scripting.Dictionary")
Call erZeugeStelle("", 1, "")
Range("A1").Resize(myDict.Count) = WorksheetFunction.Transpose(myDict.keys)
Debug.Print Timer - tmr
End Sub
Sub erZeugeStelle(ByVal perMut As String, ByVal steLLe As Long, ByVal vorZaehler As String)
Dim stelleOK As Boolean
Dim zaeHler As Long
For zaeHler = 0 To 9
If InStr(vorZaehler, zaeHler) = 0 Then
If steLLe 

Gruß, Jogy
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige