Fax Icon

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Nepumuk,
ich habe da einen Code der sehr schnell kOmbinationen auflistet, also zB aus
abcd
dann alle möglichen Kombinationen wie
abcd
abdc
acbd
acdb
usw
erzeugt. Leider bricht er mir ab ( im Windows-Taskmanager erscheint dann "reagiert nicht" für Excel-Vba) wenn ich weit mehr als 4 Zeichen/Ziffern habe.
Ich nehme an y() wird dann zu gross und vba verabschiedet sich ohne Fehlermeldung.
Was ich suche ist ein Code, der mir schnell aus z.B einer 30 Zeichen langen Zeichenkette alle Kombinationen/Reihenfolgen auflistet.
Und dabei von selbst die Spalten wechselt wenn die Spalte voll ist und wenn Spalte 256 voll ist ein neues Blatt anlegt usw.
Wobei das Reinschreiben in Tabelle(n) gar nicht unbedingt nötig ist.
Zum Verstehen meines Wunsches, Hintergrund ist, einen Antianagrammgenerator zu basteln zur Lösung von Buchstabensuppen.
Also als Beispiel, die Buchstabensuppe ist: "ierndrah" und ich habe eine Liste mit Vornamen, dann soll der Code alle Kombinationen von "ierndrah" erzeugen und jeden Wert mit der Vornamenliste abgleichen um dann die Lösung: "reinhard" zu finden.
Den Vergleich mit der Liste krieg ich ja hin, aber nicht die Kombinationserzeugung, die schnell sein muss, denn wie gesagt es können auch ca. 30 Zeichen sein die miteinander kombiniert werden wenn es nicht um Vornamen geht, sondern zum Beispiel um Dichter mit Vor- und Zunamen gehen sollte.
Die Datei: https://www.herber.de/bbs/user/18457.xls
Der Code ist nachfolgend gelistet. Scheint sehr guter Code zu sein, nix kapier daran :-)
Es würde mich erfreuen wenn du oder andere mir einen entsprechenden Code erstellen könnten.
Gruß
Reinhard
Sub Test()
Dim i As Long
Dim src As Range
Dim dest As Range
Dim y() As String
Set src = Range("A1")
Set dest = Range("B1")
ReDim y(1 To 1)
y(1) = ""
Do Until IsEmpty(src)
Include Left(src.Text, 1), y
Set src = src.Offset(1, 0)
Loop
For i = 1 To UBound(y)
dest(i, 1).Value = y(i)
Next i
dest.Resize(UBound(y)).Sort dest
End Sub


Private Sub Include(x As String, y As Variant)
Dim i As Long
Dim j As Long
Dim m As Long
Dim n As Long
m = UBound(y)
n = Len(y(1))
ReDim Preserve y(1 To m * (n + 1))
For i = n To 0 Step -1
For j = 1 To m
y(i * m + j) = Left(y(j), i) & x & Right(y(j), n - i)
Next j
Next i
End Sub

@Fred jepp, glaub schon dass die Kombinationsanzahl gigantisch werden kann :-)
Hallo Nepumuk,
gibt es da eine schnelle Variante, so wie bubblesort und je nach Fall andere Algorithmen schneller sortieren können als einfache Sortierschleifen.
Wie ist denn eine schnelle Variante um "ierndrah" in der Liste:
Fritz
Peter
Reinhard
Klaus
Maria
zu finden? Mir fällt da nur eine Schleife ein,
entweder so
If "i" in Liste(x) dann
if "e" in Liste(x) dann
If "r" in Liste(x) dann
usw
oder ich mache es so:
Ich bilde von "ierndrah" die Summe aller ZeichenAsciiWerte, dann gehe ich die Liste durch, checke für jeden Namen ob die Summe gleich ist, dann die einzelne Buchstabenprüfung. *hmmh* gar nicht so schlecht die Idee, die Zeichensummen zu jedem Namen in der Liste kann ich ja einmalig bilden lassen und neben dem Namen in der Tabelle ablegen. Das brauch ja nicht ontime geschehen.
Das kriege ich alles per VBA gelöst, aber hast du oder jmd einen besseren, schnelleren Ansatz?
Gruß
Reinhard

Beliebteste Forumthreads (12 Monate)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread