Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1064to1068
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

Zahlen ohne doppelte Ziffern

Zahlen ohne doppelte Ziffern
oliver
ich brauche 25'000 fünfstellige zahlen. in keiner zahl darf die selbe ziffer mehr als einmal vorkommen. wie kann ich dies im excel bewerkstelligen?
ein beispiel falls das unlogisch klingt;
richtige zahlen; 012324, 12345, 23456, 34567, 45678, 56789, 67890 usw...
falsche zahlen; 012234, 12342, 45676, 45675, 78948, 89129, 45234 usw...
ich bin für jeden nützlichen hinweis sehr dankbar - ich brauche die zahlen unbedingt und dringend.
herzlichen dank und frohe ostern!
gruss oli :-)

45
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Zahlen ohne doppelte Ziffern
Rudi
Hallo,
so viele gibt es nicht.
Gruß
Rudi
es gibt 30.240
WF
Hi,
=VARIATIONEN(10;5)
Salut WF
AW: es gibt 30.240
Rudi
Hallo,
schön, aber eine Ziffer mit ner 0 am Anfang ist nicht wirklich 5-stellig.
Gruß
Rudi
womit Du auch wiederum Recht hast
WF
.
AW: wenn wir grad beim Klugscheissen sind
Daniel
eine Ziffer ist immer einstellig !
andererseits, wenn ich 5-stellige Zahlen brauche
wenn 01234 nicht 5-stellig ist sondern nur 4-stellig, ist dann 12340 nicht auch nur 4-stellig?
sind das vielleicht am Ende die gleichen Zahlen?
aber seis drum, wenn 01234 als vierstellige Zahl nicht mitspielen darf, sinds nur noch 27216 Kombinationen.
Gruß, Daniel
q.e.d.: es sind also mehr als 25.000
WF
.
AW: q.e.d.: es sind also mehr als 25.000
oliver
aaaaalso; 01234 ist für mich durchaus eine fünfstellige ziffer - denn die null ist durchaus auch eine ziffer - nur eben mit einem kleinen wert. die unterhaltung über null oder nicht null ist ja nett - aber wie mache ich es denn jetzt damit ich diese ziffern erhalte? um eine kleine anleitung wär ich doch äusserst dankbar :-)
lieber gruss vom oli
Anzeige
012324 ist fünfstellig?
Wie
oT
AW: Zahlen ohne doppelte Ziffern
Original
Hi,
auf die Schnelle würde ich sagen, dass nur 2520 Kombinationen möglich sind.
mfg Kurt
Zahlen ohne doppelte Ziffern..auch für die andern
Oberschlumpf
Hi oliver
Versuch es mal hiermit:
https://www.herber.de/bbs/user/61108.xls
Es werden allerdings nur "echte" 5stellige Zahlen eingetragen - also OHNE führende 0
Und es dauert n paar viele Minuten, bis Code fertig ist.
Vielleicht hat ja noch jemand Optinierungsidee.
Hilfts?
Frage an alle:
Wieso meint ihr, dass es - nicht 25000 oder nur 30240 - Kombis gibt?
5stellige Zahlen sind doch
10.000 - 99.999
Nach meiner Logik sind das 90.000 verschiedene 5stellige Zahlen.
Oder was hab ich übersehen/falsch verstanden?
Ciao
Thorsten
Anzeige
AW: Zahlen ohne doppelte Ziffern..auch für die andern
Hajo_Zi
Hallo Torsten
es sollte aber keine Ziffer mehrmals enthalten sein als nicht 12245, so Stand es in seinem Text. Sein Beispiel war falsch.
Gruß Hajo
AW: Zahlen ohne doppelte Ziffern..auch für die andern
Daniel
Hi
dieses Makro erzeugt alle möglichen Kombinationen, man kann einstellen, ob die Zahlen mit 0 beginnen dürfen oder nicht. Von dieser Liste kannst du dir dann ja 25000 raussuchen.

sub Test
Dim x1 As Integer, x2 As Integer, x3 As Integer, x5 As Integer, x4 As Integer
Dim i As Long
Dim Zähler As Long
Dim Check As Boolean
Columns(1).ClearContents
Application.ScreenUpdating = False
For x1 = 1 To 9 'wenn 01234 auch eine Zulassige Kombination ist, hier 0 statt 1 eintragen
For x2 = 0 To 9
For x3 = 0 To 9
For x4 = 0 To 9
For x5 = 0 To 9
Check = False
Check = Check Or (x1 = x2)
Check = Check Or (x1 = x3)
Check = Check Or (x1 = x4)
Check = Check Or (x1 = x5)
Check = Check Or (x2 = x3)
Check = Check Or (x2 = x4)
Check = Check Or (x2 = x5)
Check = Check Or (x3 = x4)
Check = Check Or (x3 = x5)
Check = Check Or (x4 = x5)
If Not Check Then
Zähler = Zähler + 1
Cells(Zähler, 1).Value = "'" & x1 & x2 & x3 & x4 & x5
Application.StatusBar = Zähler
End If
Next
Next
Next
Next
Next
Cells(1, 2) = Zähler
Application.StatusBar = False


Gruß, Daniel

Anzeige
AW: Zahlen ohne doppelte Ziffern..auch für die andern
Oberschlumpf
Hi HaJo
Ach so...also 12345 = JA dagegen 11345 = NEIN..oki, hab verstanden.
Dann mag meine Idee vielleicht ne gute sein...aber...zu diesem Problem passt sie leider nicht :-)
Ciao
Thorsten
Test, ob doppelte vorkommen, oder nicht
WF
Hi,
folgende Arrayformel:
{=SUMME((VERGLEICH(TEIL(E1;ZEILE(1:5);1);TEIL(E1;ZEILE(1:5);1);0)=ZEILE(1:5))*1)=5}
ARRAY-Formel {=geschweifte Klammern} nicht eingeben;
Abschluß der Formel mit gleichzeitig Strg / Shift / Enter (statt Enter allein); - das erzeugt sie.
Salut WF
AW: Zahlen ohne doppelte Ziffern
Rudi
Hallo,
das tut's. Läuft aber ca. 6 Sekunden.

Sub tt()
Dim i As Long, strTmp As String, j As Integer, strMid As String
Dim oTmp As Object, oData As Object
Set oTmp = CreateObject("scripting.dictionary")
Set oData = CreateObject("scripting.dictionary")
For i = 10000 To 99999
strTmp = Format(i, "00000")
oTmp.removeall
For j = 1 To 5
strMid = Mid(strTmp, j, 1)
If Not oTmp.exists(strMid) Then oTmp.Add strMid, "x"
Next
If oTmp.Count = 5 Then oData.Add "'" & strTmp, "x"
Next
Columns(1).ClearContents
Cells(1, 1).Resize(oData.Count) = WorksheetFunction.Transpose(oData.keys)
End Sub


Gruß
Rudi

Anzeige
habe auch eine
Tino
Hallo,
habe auch eine Version zusammengebastelt.
Sub Zahlen()
Dim Bereich As Range
Dim MyAr, tempBereich
Dim A As Long, B As Long, i As Integer

Set Bereich = Range("A1:A99999")
Bereich.Value = ""
Bereich.NumberFormat = "General"
MyAr = Bereich
Bereich.Value = ""

Bereich.FormulaR1C1 = "=TEXT(ROW(),""00000"")"
tempBereich = Bereich

For A = Lbound(tempBereich) To Ubound(tempBereich)
 
    For B = 0 To 9
     If Len(Replace(tempBereich(A, 1), B, "")) < 4 Then GoTo goNext
    Next B
    i = i + 1
 
    MyAr(i, 1) = tempBereich(A, 1)

goNext:
Next A

Bereich.NumberFormat = "@"
Bereich = MyAr
End Sub


Gruß Tino

Anzeige
AW: Office-Version des Fragestellers beachten
Daniel
Hi
das Programm ist aber nur in Excel 2007 lauffähig.
in älteren Excelversionen können die Zahlen grösser 65536 so nicht berücksichtigt werden
Gruß, Daniel
stimmt mist, so sind es nur 20034 :-( oT.
Tino
AW: Code optimiert
Daniel
Hi
hier mal der Code optimiert für Excelversionen ab Excel 97
war eh etwas umständlich, was du da gemacht hats.
das Goto hab ich auch rausgenommen, sowas ist kein guter Programmierstil und in VBA nicht notwendig.
ansonsten ist die Idee zur Lösung echt gut.

Sub Zahlen()
Dim MyAr()
Dim A As Long, B As Long, i As Integer
Columns(1).ClearContents
For A = 1234 To 98765
For B = 0 To 9
If Len(Replace(Format(A, "00000"), B, "")) 


Gruß, Daniel

Anzeige
Nachfrage?
Tino
Hallo Daniel,
was soll an GoTo schlecht sein, was macht einen Code bei Verwendung durch GoTo schlecht?
Nicht falsch verstehen, möchte nur dazu lernen.
Gruß Tino
AW: Nachfrage?
Daniel
Hi
- es erschwert das Verständnis des Programmes, weil hinter dem GOTO keine Logik steckt. Ich kann z.B. nicht erkennen ob jetzt die Schleife verlassen wird oder innerhalb der Schleife an eine andere Stelle angesprungen wird, ob vor- oder zurück gesprungen wird, ich muss den ganzen Code nach der Sprungmarke durchsuchen um zu verstehen was passiert.
Dh. eine ausführliche Dokumentation durch kommentare wäre hier erforderlich.
bei "EXIT FOR" ist klar was passiert und wo hingesprungen wird, eine weiter Erläuterung ist eigentlich nicht erforderlich.
bei so kurzen Programmen ist das kein Problem, aber wenn der Code mal komplexer wird oder du dich in einem dir unbekannten Code (es reicht schon wenn dein eigener Code ein paar Monate alt ist, daß er dir unbekannt vorkommt) zurechtfinden musst, wirst du jedes Goto wahrscheinlich verfluchen.
- dadurch, das Per GOTO überall hingesprungen werden kann, ergeben sich natürlich unendliche Fehlermöglichkeiten, die nicht alle vom System abgefangen werden (z.B. Sprung in/aus Schleifen, IF-THEN-Blöcken, WITH-Klammern usw.
GOTO war früher mal notwenig, als IF-THEN und FOR...NEXT die einzigen Kontrollstrukturen waren und es auch sonst keine Möglichkeit gab, Modular und Strukturiert zu programmieren , aber das war noch zu seligen C64-Zeiten.
Gruß, Daniel
Anzeige
ist Logisch
Tino
Hallo Daniel,
danke für den stups, naja so oft kommt es ja nicht vor dass ich GoTo verwende.
Im Beispiel habe ich mir allerdings durch Goto, 69760mal die If und End if Zeile gespart. ;-)
Gruß Tino
Im Zuge der Entwicklung problemorientierter...
Luc:-?
...Pgmiersprachen ist man von der Befehlsstruktur älterer Sprachen abgekommen und versucht, das durch eine reihenfolgegerechte logische Struktur zu ersetzen. In Sprachen der letzten Generation geht das auch nicht anders! VB und VBA gehören aber nicht dazu, so dass die gelegentliche Verwendung von Go-Anweisungen relativ unschädlich ist und mitunter sogar die Übersichtlichkeit erhöht (besonders im Falle von GoSub und in Verbindung mit On...). Man sollte bloß möglichst vorwärts und nicht rückwärts springen. Ganz schlechter Pgmierstil wäre es allerdings, diese Anweisungen inflationär zu verwenden.
Frohe Ostern!
Luc :-?
Anzeige
AW: Im Zuge der Entwicklung problemorientierter...
Tino
Hallo Luc,
danke, aber lese ich jetzt richtig, ist Deine Aussage anders wie die von Daniel? (Teilweise)
Im meinem Code springe ich vorwärts.
Wünsche auch Frohe Ostern und dicke Eier.
Gruß Tino
Teils-teils, weil ich gelegtl auch "Gehen tue"...
Luc:-?
...;-) Sehe das deshalb nicht so verbissen (falls sinnvoll geht's auch mal rückwärts)...
Als gute Vorübung für Sprachen ohne Sprünge aber ohne GoTo sehr sinnvoll. Lohnt nur nicht immer den Aufwand!
Gruß Luc :-?
so jetzt aber auch für xl2003 ;-)
Tino
Hallo,
Sub Zahlen()
Dim Bereich As Range
Dim MyAr(), tempBereich(99999)
Dim A As Long, B As Long, i As Integer
With Application
 .ScreenUpdating = False
  Columns(1).Value = ""
    For A = 1 To 100000
     tempBereich(A - 1) = Format(A, "00000")
    Next A
    
    For A = Lbound(tempBereich) To Ubound(tempBereich)
     
        For B = 0 To 9
         If Len(Replace(tempBereich(A), B, "")) < 4 Then GoTo goNext
        Next B
        
        Redim Preserve MyAr(i)
        MyAr(i) = tempBereich(A)
        i = i + 1
goNext:
    Next A
    
    Columns(1).NumberFormat = "@"
    Range("A1").Resize(Ubound(MyAr) + 1) = .Transpose(MyAr)
 
 .ScreenUpdating = True
End With
End Sub


Gruß Tino

Anzeige
Effektives Programmieren
Daniel
Hi
das ist mal ein schönes Beispiel, um die Effektivität von verschiedenen Programmierungsarten auszuprobieren und zu erlerenen.
hier sind 5 Problemlösungsvarianten, jeweils mit Zeitmessung.
die Laufzeit wird in Zeile 1 gezeigt.
gestoppt wird nur die Laufzeit der Schleife, nicht das Rückschreiben der Werte, das ist sowieso bei allen gleich.
Variante 1:
Tinos lösungsansatz mit der Replace-Funktion und dem Goto-Sprung
Variante 2:
Tinos Lösung mit der Replace-Funktion aber ohne den Goto-Sprung, dafür mit Exit-For und IF-Prüfung
Variante 3:
Alternative Prüfung, es werden die Häufigkeiten der einzelnen Ziffern aufsummiert und der Max-Wert der HÄufigkeiten untersucht (muss 1 sein)
Variante 4:
statt einer Zählschleife werden 5 Verschachtelte Schleifen (für jede Ziffer eine) verwendet, dadurch entfällt die Vereinzelung der Ziffern (String-Funktion)
Variante 5:
auch wieder 5 Schleifen (für jede Ziffer), jetzt werden die Ziffern direkt miteinander verglichen.
Es ergeben sich folgende Erkenntnisse:
1. die Variante 5 ist die schnellste, obwohl sie den meisten Programmcode enthält. Allerdings werden nur sehr einfache Funktionen verwendet, nur direkte Vergleiche und Boolsche Operationen, keine String-Operationen
Variante 1 und 2 und 3 sind recht langsam, weil aufwendigen String- und Umform-Funktionen verwendet werden.
2. der Goto-Stprung hat keinen Positiven Einfluss auf die Geschwindigkeit, Variante 1 und 2 sind gleich schnell. Wahrscheinlich wird die Gesparte Zeit beim IF-Vergleich durch das Suchen der Sprungmarke wieder kompensiert
Ergo: kurzer und eleganter Code ist nicht immer schnell, es kommt auch auf die verwendeten Funktionen an.
alles was mit Strings zu tun hat, bremst.
Allerdings muss man hier natürlich abwägen, zwischen dem Zeitaufwand den Code zu erstellen und zu pflegen und der Zeit für den Programmlauf.

Sub Zahlen1()
Dim MyAr()
Dim A As Long, B As Long, i As Integer
Dim t As Double
Columns(1).ClearContents
Columns(1).NumberFormat = "00000"
t = Timer '-------------------------------
For A = 1234 To 98765
For B = 0 To 9
If Len(Replace(Format(A, "00000"), B, "")) 



Sub Zahlen2()
Dim MyAr()
Dim A As Long, B As Long, i As Integer
Dim t As Double
Columns(2).ClearContents
Columns(2).NumberFormat = "00000"
t = Timer '-----------------------------------
For A = 1234 To 98765
For B = 0 To 9
If Len(Replace(Format(A, "00000"), B, "")) 



Sub Zahlen3()
Dim t As Double
Dim MyAr()
Dim A As Long, B As Long, i As Integer, x As Integer
Dim check(9)
Columns(3).ClearContents
Columns(3).NumberFormat = "00000"
t = Timer '--------------------------------------
For A = 1234 To 98765
Erase check
For B = 1 To 5
x = Mid$(Format(A, "00000"), B, 1)
check(x) = check(x) + 1
Next B
If WorksheetFunction.Max(check) = 1 Then
i = i + 1
ReDim Preserve MyAr(1 To 1, 1 To i)
MyAr(1, i) = A
End If
Next A
t = Timer - t '----------------------------------------
Cells(1, 3).Value = t
Cells(2, 3).Resize(UBound(MyAr, 2), UBound(MyAr, 1)) = WorksheetFunction.Transpose(MyAr)
Rows(1).NumberFormat = "General"
End Sub



Sub Zahlen4()
Dim t As Double
Dim MyAr()
Dim A1 As Integer, A2 As Integer, A3 As Integer, A4 As Integer, A5 As Integer, B As Long, i  _
As Integer, x As Integer
Dim check(9) As Integer
Columns(4).ClearContents
Columns(4).NumberFormat = "00000"
t = Timer '-------------------------------------
For A1 = 0 To 9
For A2 = 0 To 9
For A3 = 0 To 9
For A4 = 0 To 9
For A5 = 0 To 9
Erase check
check(A1) = check(A1) + 1
check(A2) = check(A2) + 1
check(A3) = check(A3) + 1
check(A4) = check(A4) + 1
check(A5) = check(A5) + 1
If WorksheetFunction.Max(check) = 1 Then
i = i + 1
ReDim Preserve MyAr(1 To 1, 1 To i)
MyAr(1, i) = A1 * 10000# + A2 * 1000 + A3 * 100 + A4 * 10 + A5
End If
Next A5
Next A4
Next A3
Next A2
Next A1
t = Timer - t '-------------------------------------
Cells(1, 4).Value = t
Cells(2, 4).Resize(UBound(MyAr, 2), UBound(MyAr, 1)) = WorksheetFunction.Transpose(MyAr)
Rows(1).NumberFormat = "General"
End Sub



Sub Zahlen5()
Dim t As Double
Dim MyAr()
Dim A1 As Integer, A2 As Integer, A3 As Integer, A4 As Integer, A5 As Integer, B As Long, i  _
As Integer, x As Integer
Dim check As Boolean
Columns(5).ClearContents
Columns(5).NumberFormat = "00000"
t = Timer '---------------------------------
For A1 = 0 To 9
For A2 = 0 To 9
For A3 = 0 To 9
For A4 = 0 To 9
For A5 = 0 To 9
check = False
check = check Or (A1 = A2)
check = check Or (A1 = A3)
check = check Or (A1 = A4)
check = check Or (A1 = A5)
check = check Or (A2 = A3)
check = check Or (A2 = A4)
check = check Or (A2 = A5)
check = check Or (A3 = A4)
check = check Or (A3 = A5)
check = check Or (A4 = A5)
If Not check Then
i = i + 1
ReDim Preserve MyAr(1 To 1, 1 To i)
MyAr(1, i) = A1 * 10000# + A2 * 1000 + A3 * 100 + A4 * 10 + A5
End If
Next A5
Next A4
Next A3
Next A2
Next A1
t = Timer - t '-------------------------
Cells(1, 5).Value = t
Cells(2, 5).Resize(UBound(MyAr, 2), UBound(MyAr, 1)) = WorksheetFunction.Transpose(MyAr)
Rows(1).NumberFormat = "General"
End Sub


Gruß, Daniel

...und darauf kommt's in 1.Linie an...
Luc:-?
...Zitat: Allerdings muss man hier natürlich abwägen, zwischen dem Zeitaufwand den Code zu erstellen und zu pflegen und der Zeit für den Programmlauf..., Daniel,
sonst könnte man ja gleich alles "geradeaus" pgmieren, das ist immer am schnellsten... ;-)
Einen Zyklus ("Schleife") verlässt man natürlich auch nicht mit GoTo (wirklich meist schlechter Stil, weil fehleranfällig und zusätzliche dll-Abläufe provozierend), dafür gibt's ja Exit... Muss man sich bloß 'ne zusätzliche Prüfbedingung überlegen, wenn man feststellen muss, ob der Zyklus vorzeitig beendet wurde (meist reicht Abfrage einer vorhandenen Laufvariable).
Frohe Ostern!
Luc :-?
AW: ...und darauf kommt's in 1.Linie an...
Daniel
Hi
ich hätte die 5. Variante schon gerne etwas kompakter geschrieben, aber hierfür hätte ich die Schleifenvariablen A1-A5 als Index-Variablen A(5) verwenden müssen, dies wird von VBA aber nicht zugelassen, es kommt die Meldung, "Schleifenvariable wird schon verwendet" trotz unterschiedlichem Index.
letzlich ist es auch eine Frage, ob und in welche Richtung das Programm flexibel gestaltet werden soll.
Varianten 1-3 ließen sich leicht anpassen, wenn verschiedene Zahlenlängen gefragt wären ( 2,3,4 oder 5 Ziffern) bzw es ließe sich per Variable steuern, dies ist bei Variante 4-5 nicht möglich, hierfür müsste der Code strukurell angepasst werden.
Anders siehts aus, wenn die Wahlmöglichkeit der Ziffern für die Kombinationen flexiblel gestaltet werden soll (statt 0...9 z.b. 1...4). Hier wären die Varianten 4-5 deutlich besser geeignet als 1-3.
Gruß, Daniel
AW: ...und darauf kommt's in 1.Linie an...
Tino
Hallo,
es spielt aber auch immer eine rolle wie man sich mit dem problem beschäftigt.
So wie Daniel habe ich mich nicht damit beschäftigt, habe den ersten gedanken von mir umgesetzt.
Bin unterwegs und kann nicht besser schreiben.
Gruß Tino
AW: ...und darauf kommt's in 1.Linie an...
Tino
Hallo,
Deine Version 5 ist von der Geschwindigkeit wahrscheinlich nicht zu toppen. (nicht schlecht)
Hat auch ein wenig gebraucht, bis ich dass System verstanden habe.
Haben wir eigentlich Oliver vertrieben oder warum meldet er sich nicht mehr?
Hier noch die Version mit dem Vorschlag von Daniel ohne Verwendung von GoTo.
Allerdings macht dies bei mir ca. 5 Hundertstel Sekunden aus. ;-)
Sub Zahlen()
Dim MyAr() As String
Dim A As Long, B As Long
Dim i As Integer
Dim t As Single
Dim sZahl As String
  
t = Timer
    
    For A = 1 To 100000
        sZahl = Format(A, "00000")
    
        For B = 0 To 9
            If Len(Replace(sZahl, B, "")) < 4 Then Exit For
        Next B
        
        If B = 10 Then
            Redim Preserve MyAr(i)
            MyAr(i) = sZahl
            i = i + 1
        End If
    Next A

t = Timer - t

With Application
 .ScreenUpdating = False
    Columns(6).Value = ""
    Cells(1, 6).Value = t
    Columns(6).NumberFormat = "@"
    
    Range("F2").Resize(Ubound(MyAr) + 1) = .Transpose(MyAr)
 .ScreenUpdating = True
End With

End Sub


Gruß Tino

AW: Variante 6
Erich
Hallo zusammen,
etwas verspätet hab ich mich jetzt auch noch an den Thread gehängt und poste als Nr. 6
eine noch schnellere Variante von Daniels "Zahlen5":

Sub Zahlen6()
Dim t As Double, MyAr() As Long, i As Long, check As Boolean
Dim A1 As Long, A2 As Long, A3 As Long, A4 As Long, A5 As Long
Columns(6).ClearContents
Columns(6).NumberFormat = "General"
ReDim MyAr(1 To 99999)                 ' groß genug dimensionieren
t = Timer '---------------------------------
For A1 = 1 To 9
For A2 = 0 To 9
For A3 = 0 To 9
For A4 = 0 To 9
For A5 = 0 To 9
check = (A1 = A2) Or (A1 = A3) Or (A1 = A4) Or (A1 = A5)
If Not check Then
check = check Or (A2 = A3) Or (A2 = A4) Or (A2 = A5)
If Not check Then
check = check Or (A3 = A4) Or (A3 = A5)
check = check Or (A4 = A5)
If Not check Then
i = i + 1
MyAr(i) = (((A1 * 10 + A2) * 10 + A3) * 10 + A4) * 10 + A5
End If
End If
End If
Next A5
Next A4
Next A3
Next A2
Next A1
ReDim Preserve MyAr(1 To i)            ' einmaliges ReDim hinter den Schleifen
t = Timer - t '-------------------------
Cells(1, 6).Value = t
Cells(2, 6).Resize(i) = Application.Transpose(MyAr)
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

AW: Variante 6
Tino
Hallo,
geniale Idee die Matrix am Schluss erst zurechtzustutzen.
Habe ich direkt mal an meiner Version getestet,
leider Fehlanzeige dass spielt sich wirklich nur im Hundertstel Bereich ab.
Gruß Tino
AW: Keine Überflüssige Arbeit in der Schleife
Daniel
HI
gute Idee, alles Überfüssige aus der Schleife rauszunehmen.
konsequenterweise sollte man dann für jede Prüfung ein IF-THEN verwenden, dann wirds noch schneller.
eigentlich Schade, daß die kurzen, kreativsten Lösungen (z.B. Tinos "Replace") so langsam sind ;-)
Gruß, Daniel
AW: Keine Überflüssige Arbeit in der Schleife
Tino
Hallo,
Naja lahm ist ja relativ ;-)
Mit einigen Optimierungen und Anpassungen die sich unter anderem erst hier ergeben haben,
konnte ich die Dauer auf 1,5 Sekunden drücken.
Sagen wir mal so, auf die Idee es so wie Du es gemacht hast wäre ich sowieso nicht gekommen,
also bin ich mit meiner Variante doch recht zufrieden. ;-)
Natürlich weis ich ja jetzt, dass Deine schneller ist und würde mich selbstverständlich auch demnach für diese entscheiden.
Die Variante von Erich haut das Ding in 0,05 Sekunden weg. (der Hammer)
Gruß Tino
AW: noch ne Variante mit einer Schleife
Erich
Hi zusammen,
und noch ne Variante, die mit der großen Schleife bis 98765, aber ohne Stringoperationen arbeitet.
Nach der Geschwindigkeit landet diese Variante bei mir auf Platz 2:

Sub Zahlen8()
Dim MyAr() As Long, A As Long, B As Long, i As Long
Dim t As Single, sZahl As String
Dim a1 As Integer, a2 As Integer, a3 As Integer, a4 As Integer, a5 As Integer
Dim ss As Long
Columns(8).ClearContents
Columns(8).NumberFormat = "General"
ReDim MyAr(1 To 98765)
t = Timer
For A = 10234 To 98765
a1 = Fix(A / 10000)
ss = a1 * 10000&
a2 = Fix((A - ss) / 1000)
If a1  a2 Then
ss = ss + a2 * 1000
a3 = Fix((A - ss) / 100)
If a1  a3 And a2  a3 Then
ss = ss + a3 * 100
a4 = Fix((A - ss) / 10)
If a1  a4 And a2  a4 And a3  a4 Then
ss = ss + a4 * 10
a5 = A - ss
If a1  a5 And a2  a5 And a3  a5 And a4  a5 Then _
i = i + 1: MyAr(i) = A
End If
End If
End If
Next A
ReDim Preserve MyAr(1 To i)
t = Timer - t
Cells(1, 8).Value = t
Cells(2, 8).Resize(UBound(MyAr)) = Application.Transpose(MyAr)
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

AW: noch ne Variante mit einer Schleife
Tino
Hallo,
wirklich nicht schlecht.
Was ich nicht so gut finde, man braucht sehr lange (zumindest ich) um diesen Code zu verstehen, dies macht eine eventuelle Anpassung recht schwierig.
Gruß Tino
AW: noch ne Variante mit einer Schleife
Daniel
HI
jetzt nochmal 2 Varianten, die ich aus den Erkenntnissen und Ideen der bisherigen Beiträge zusammengestellt habe.
Variante 9 finde ich sehr elegant, weil alle gleichartigen arbeiten in einer Schleife abgebildet werden, trotzdem werden keine String-Funktionen verwendet. Allerdings ist die Version auch nicht besonders schnell (wobei ich den Grund dafür noch nicht so ganz erkenne, vielleicht weiß da jemand weiter.
Variante 10 ist das schnellste, was ich bisher gefunden habe, aber das ist halt einfach ein bisschen BruteForce und langer Code

Sub Zahlen9()
Dim MyAr() As Long, A As Long, i As Long
Dim t As Single
Dim x As Integer, y As Integer
Dim aa(4) As Integer
Dim ss As Long
Columns(9).ClearContents
Columns(9).NumberFormat = "General"
ReDim MyAr(1 To 98765)
t = Timer
For A = 1234 To 98765
For x = 0 To 4
aa(x) = Fix(A / 10 ^ x) - 10 * Fix(A / 10 ^ (x + 1))
For y = (x - 1) To 0 Step -1
If aa(x) = aa(y) Then GoTo Sprung
Next
Next
i = i + 1: MyAr(i) = A
Sprung:
Next A
ReDim Preserve MyAr(1 To i)
t = Timer - t
Cells(1, 9).Value = t
Cells(2, 9).Resize(UBound(MyAr)) = Application.Transpose(MyAr)
End Sub



Sub Zahlen10()
Dim t As Double
Dim MyAr()
Dim a1 As Integer, a2 As Integer, a3 As Integer, a4 As Integer, a5 As Integer, B As Long, i  _
_
As Integer, x As Integer
Dim check As Boolean
ReDim MyAr(1 To 99999)
Columns(10).ClearContents
Columns(10).NumberFormat = "00000"
t = Timer '---------------------------------
For a1 = 0 To 9
For a2 = 0 To 9
For a3 = 0 To 9
For a4 = 0 To 9
For a5 = 0 To 9
If a1  a2 Then
If a1  a3 Then
If a1  a4 Then
If a1  a5 Then
If a2  a3 Then
If a2  a4 Then
If a2  a5 Then
If a3  a4 Then
If a3  a5 Then
If a4  a5 Then
i = i + 1:  MyAr(i) = a1 * 10000# + a2 * 1000 + a3 * 100 + a4 * 10 + a5
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next a5
Next a4
Next a3
Next a2
Next a1
ReDim Preserve MyAr(1 To i)
t = Timer - t '-------------------------
Cells(1, 10).Value = t
Cells(2, 10).Resize(UBound(MyAr)) = Application.Transpose(MyAr)
Rows(1).NumberFormat = "General"
End Sub


also ich finde es spannend lehrreich, wieviele verschiedene Lösungsansätze bisher zu dem Problem gefunden wurden
Frohe Ostern an Alle

AW: noch ne Variante mit einer Schleife
Tino
Hallo,
wie Du schon geschrieben hast ist es wirklich erstaunlich wie viele Varianten es dazu gibt,
bin auch schlicht weg beindruckt wie schnell Eure Versionen sind.
Ich wäre niemals auf den Gedanken gekommen eine solche Variante aufzubauen.
Ich möchte aber auch noch was beitragen, hat jetzt aber nichts mit der Schleife zu tun.
Columns(10).ClearContents ist etwas langsamer wie Columns(10).Value = "" (bei gefüllten Zellen)
Gruß Tino
AW: noch ne Variante mit einer Schleife
Erich
Hi Daniel, Tino und alle anderen,
bevor jetzt gleich jemand ein Streichholz an einen Haufen Holz hält,
aus dem ein Osterfeuer lodern soll - und das bei strahlendem Sonnenschein -
noch schnell eine Variante 11 aus der bisher schnellsten 10:

Sub Zahlen11()
Dim t As Double, MyAr() As Long, B As Long, i As Integer, x As Integer
Dim check As Boolean
Dim a1 As Long, a2 As Long, a3 As Long, a4 As Long, a5 As Long
ReDim MyAr(1 To 99999)
Columns(11).ClearContents
Columns(11).NumberFormat = "General"
t = Timer '---------------------------------
For a1 = 1 To 9
For a2 = 0 To 9
If a1  a2 Then
For a3 = 0 To 9
If a1  a3 Then
If a2  a3 Then
For a4 = 0 To 9
If a1  a4 Then
If a2  a4 Then
If a3  a4 Then
For a5 = 0 To 9
If a1  a5 Then
If a2  a5 Then
If a3  a5 Then
If a4  a5 Then
i = i + 1
MyAr(i) = a1 * 10000 + a2 * 1000 + a3 * 100 + a4 * 10 + a5
End If
End If
End If
End If
Next a5
End If
End If
End If
Next a4
End If
End If
Next a3
End If
Next a2
Next a1
ReDim Preserve MyAr(1 To i)
t = Timer - t '-------------------------
Cells(1, 11).Value = t
Cells(2, 11).Resize(UBound(MyAr)) = Application.Transpose(MyAr)
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort und: Schönes Ostereiersuchen!

AW: noch ne Variante mit einer Schleife
Tino
Hallo Erich,
es sind noch 245 Spalten frei für weitere Versionen. ;-)
Gruß Tino
AW: noch ne Variante mit einer Schleife
Tino
Hallo Erich,
es sind noch 245 Spalten frei für weitere Versionen. ;-)
Gruß Tino
AW: das ist dann mal wirklich konsequent
Daniel
nur das tun, was notwendig ist.
reeespect und frohe Ostern, Daniel
AW: das ist dann mal wirklich konsequent
oliver
hui da hab ich ja wasgezettelt ;-)
jetzt aber mal ne anfängerfrage dazwischen; wo kopiere ich denn jetzt das script rein damit das auch funktioniert? ich bin kein programmierer - sondern anwender. vielen dank für eine ganz einfache erklärung wie man das einsetzt was ihr da gezaubert habt...
gruss oli :-)

310 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige