4 Stelliger Code aus 0-5 ohne benachbarte Doppel

Forumthread: 4 Stelliger Code aus 0-5 ohne benachbarte Doppel

13.01.2016 12:28:33

Kolja

Hy Leute,
hab mich schon ein bisschen durch diesen Thread gefräst:
https://www.herber.de/forum/archiv/1064to1068/1067973_Zahlen_ohne_doppelte_Ziffern.html
Kriege aber die Makros nicht so modifiziert wie ich es bräuchte.
Wie im Betreff gesagt brauch ich eine Liste von 4 Stelligen Codes mit führender Null mit den Ziffern 0-5 und es sollen keine 2 gleichen Ziffern nebeneinander stehen
Also:
0101 ist ok, 1001 nicht.
Wie mach ich das?
Danke schon mal im Voraus
Kolja

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: 4 Stelliger Code aus 0-5 ohne benachbarte Doppel

13.01.2016 12:38:56

Daniel

Hi
ermittle den Zufallswert in einer DO-Schleife, welche solange wiederholt wird bis der ermittelte Wert ungleich dem Vorgängerwert ist.
da hier die Chance für einen zweiten Durchlauf nur bei 20% liegt, kannst du das Problemlos machen:
Ziffer1 = 0 Ziffer2 = Worksheetfunction.RandBetween(1, 5) Do Ziffer3 = Worksheetfunction.RandBetween(0, 5) Loop while Ziffer3 = Ziffer2 Do Ziffer4 = Worksheetfunction.RandBetween(0, 5) Loop while Ziffer4 = Ziffer3 Do Ziffer5 = Worksheetfunction.RandBetween(0, 5) Loop while Ziffer5 = Ziffer4 Grúss Daniel

AW: 4 Stelliger Code aus 0-5 ohne benachbarte Doppel

13.01.2016 16:24:57

Kolja

Ja, nur so fange ich keine doppelten ab. Und es geht mir tatsächlich um eine komplette liste.
Aber ich habe gerade die Lösung gefunden, wobei die die Anzahl auf 5 Stellen erhöht habe da ich sonst zu wenige Ergbnisse bekommen hätte... Es ist eine Modifikation eines Scripts aus dem oben stehenden Thread:

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"
For a1 = 0 To 5
For a2 = 0 To 5
For a3 = 0 To 5
For a4 = 0 To 5
For a5 = 0 To 5
If a1  a2 Then
If a2  a3 Then
If a3  a4 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
Next a4
Next a3
Next a2
Next a1
ReDim Preserve MyAr(1 To i)
Cells(1, 10).Value = t
Cells(2, 10).Resize(UBound(MyAr)) = Application.Transpose(MyAr)
Rows(1).NumberFormat = "General"
End Sub

AW: 4 Stelliger Code aus 0-5 ohne benachbarte Doppel

13.01.2016 18:30:10

Daniel

achso, du willst ne Komplettliste
wenn du das If a1 a2 Then direkt unter das dazugehörige For schreibst, kannst du viele unnötige Schleifenumläufe einsparen, denn wenn schon die ersten beiden Ziffern gleich sind, brauchst du die restlichen gar nicht erst erstellen.
Gruß Daniel

AW: 4 Stelliger Code aus 0-5 ohne benachbarte Doppel

13.01.2016 13:14:48

ransi

Hallo Kolja,
so?
Tabelle1

	A
1	0101
2	0102
3	0103
4	0104
5	0105
6	0106
7	0107
8	0108
9	0109
10	0120
11	0121
12	0123
13	0124
14	usw.

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4

Option Explicit

Sub machs()
    Dim L As Long
    Dim intCounter As Integer
    For L = 0 To 999
        If testen(Format(L, "0000")) = True Then
            intCounter = intCounter + 1
            Cells(intCounter, 1) = "'" & Format(L, "0000")
        End If
    Next
End Sub

Function testen(dieZahl As String) As Boolean
    testen = True
    Dim I As Integer
    For I = 1 To Len(dieZahl) - 1
        If Mid(dieZahl, I, 1) = Mid(dieZahl, I + 1, 1) Then
            testen = False
            Exit For
        End If
    Next
End Function

ransi

AW: 4 Stelliger Code aus 0-5 ohne benachbarte Doppel

13.01.2016 13:23:59

ransi

HAllo,
aus 0-5
Sorry, nicht richtig gelesen...
So müsste es gehen:
Tabelle1

	A
1	0101
2	0102
3	0103
4	0104
5	0105
6	0120
7	0121
8	0123
9	0124
10	0125
11	0130
12	0131
13	0132
14	usw.

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4

Option Explicit

Sub machs()
    Dim L As Long
    Dim intCounter As Integer
    For L = 0 To 555
        If testen(Format(L, "0000")) = True Then
            intCounter = intCounter + 1
            Cells(intCounter, 1) = "'" & Format(L, "0000")
        End If
    Next
End Sub

Function testen(dieZahl As String) As Boolean
    Dim I As Integer
    testen = True
    For I = 1 To Len(dieZahl)
        Select Case Mid(dieZahl, I + 1, 1)
            Case 6 To 9
                testen = False
                Exit Function
            Case Mid(dieZahl, I, 1)
                testen = False
                Exit Function
        End Select
    Next
End Function

ransi

Beliebteste Forumthreads (12 Monate)

4 Stelliger Code aus 0-5 ohne benachbarte Doppel

Forumthread: 4 Stelliger Code aus 0-5 ohne benachbarte Doppel

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

4 Stelliger Code aus 0-5 ohne benachbarte Doppel

Forumthread: 4 Stelliger Code aus 0-5 ohne benachbarte Doppel

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread