Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: 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 :-)
Anzeige

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
Anzeige
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
Anzeige
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
Anzeige
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 :-?
Anzeige
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

Anzeige
...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 :-?
Anzeige
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
Anzeige
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

Anzeige
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

Anzeige
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
Anzeige
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
Anzeige
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

Anzeige
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

Anzeige
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
Anzeige
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!

Anzeige
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
Anzeige
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 :-)
Anzeige
AW: Wohin mit dem Code?
Erich
Hi Oliver,
schau dir bitte erst mal das an: http://www.online-excel.de/excel/singsel_vba.php?f=44#s2
Wenn du dann dazu Fragen hast - dafür sind wir hier!
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
;
Anzeige
Anzeige

Infobox / Tutorial

Zahlen ohne doppelte Ziffern in Excel generieren


Schritt-für-Schritt-Anleitung

Um in Excel 25.000 fünfstellige Zahlen zu generieren, in denen keine Ziffer doppelt vorkommt, kannst du VBA (Visual Basic for Applications) verwenden. Folge diesen Schritten:

  1. Öffne Excel und erstelle ein neues Arbeitsblatt.

  2. Öffne den VBA-Editor: Drücke ALT + F11.

  3. Füge ein neues Modul hinzu: Klicke auf "Einfügen" > "Modul".

  4. Kopiere den folgenden VBA-Code in das Modul:

    Sub Zahlen()
       Dim MyAr() As Long, i As Long
       Dim A1 As Long, A2 As Long, A3 As Long, A4 As Long, A5 As Long
       Dim check As Boolean
       ReDim MyAr(1 To 99999)
       For A1 = 1 To 9
           For A2 = 0 To 9
               If A1 <> A2 Then
                   For A3 = 0 To 9
                       If A1 <> A3 And A2 <> A3 Then
                           For A4 = 0 To 9
                               If A1 <> A4 And A2 <> A4 And A3 <> A4 Then
                                   For A5 = 0 To 9
                                       If A1 <> A5 And A2 <> A5 And A3 <> A5 And A4 <> A5 Then
                                           i = i + 1
                                           MyAr(i) = A1 * 10000 + A2 * 1000 + A3 * 100 + A4 * 10 + A5
                                       End If
                                   Next A5
                               End If
                           Next A4
                       End If
                   Next A3
               End If
           Next A2
       Next A1
       ReDim Preserve MyAr(1 To i)
       Cells(1, 1).Resize(i).Value = Application.Transpose(MyAr)
    End Sub
  5. Führe das Skript aus: Drücke F5 oder gehe zu "Run" > "Run Sub/UserForm".

  6. Überprüfe die generierten Zahlen in Spalte A.


Häufige Fehler und Lösungen

  • Fehler: "Laufzeitfehler 9: Index außerhalb des gültigen Bereichs"

    • Lösung: Stelle sicher, dass deine Schleifenbedingungen korrekt sind. Überprüfe die Arrays und Dimensionen.
  • Fehler: "Zahlen werden nicht korrekt generiert"

    • Lösung: Überprüfe den Code auf Tippfehler und stelle sicher, dass alle Bedingungen richtig gesetzt sind (z.B. A1 <> A2).

Alternative Methoden

Eine Alternative zur Nutzung von VBA ist die Verwendung von Excel-Formeln und Filtern. Du kannst zufällige fünfstellige Zahlen generieren und anschließend mit einer Formel die doppelten Ziffern herausfiltern. Dies kann jedoch zeitaufwendiger sein.


Praktische Beispiele

Hier sind einige Beispiele für gültige und ungültige fünfstellige Zahlen:

  • Gültige Zahlen: 12345, 67890, 10234
  • Ungültige Zahlen: 11234, 12333, 44567

Diese Beispiele zeigen, was unter fünfstelligen Zahlen mit einzigartigen Ziffern zu verstehen ist.


Tipps für Profis

  • Optimiere deinen Code, indem du Exit For anstelle von GoTo verwendest, um die Lesbarkeit und Effizienz zu erhöhen.
  • Nutze die Funktion VARIATIONEN, um schnell zu verstehen, wie viele Kombinationen möglich sind.
  • Achte darauf, die ScreenUpdating-Eigenschaft während der Ausführung des Codes auf False zu setzen, um die Ausführungsgeschwindigkeit zu erhöhen.

FAQ: Häufige Fragen

1. Wie viele fünfstellige Zahlen mit einzigartigen Ziffern gibt es? Es gibt insgesamt 30.240 Kombinationen von fünfstelligen Zahlen, wobei keine Ziffer doppelt vorkommt.

2. Wo finde ich den VBA-Editor in Excel? Du kannst den VBA-Editor öffnen, indem du ALT + F11 drückst.

3. Was ist eine fünfstellige Zahl? Eine fünfstellige Zahl ist eine Zahl, die aus genau fünf Ziffern besteht, wie z.B. 12345 oder 67890.

4. Welche Excel-Version benötige ich für diesen Code? Der bereitgestellte VBA-Code ist für Excel 2007 und neuere Versionen geeignet. In älteren Versionen kann es zu Einschränkungen bei der Anzahl der Zeilen kommen.

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige