Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1924to1928
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

Zufällige/einmalige Nummernvergabe

Zufällige/einmalige Nummernvergabe
28.03.2023 15:20:17
Urmila

Hallo liebe Community,

ich stehe gerade vor einer Aufgabe, bei der ich nicht weiterkomme.
Es soll eine 8-stellige Nummer erzeugt werden, die in 2 Hälften geteilt sein soll, die erste Zahl soll zwischen Zufallszahl zwischen 1-9 sein (damit keine mit einer 0 beginnt), die andere Hälfte (7 Zahlen) ebenfalls eine Zufallszahl, jedoch im Format "0000000" - hinzukommt, dass die Zahl einmalig vergeben werden sein kann, sprich Abfrage Duplikat.

Mit einer InputBox soll die Anzahl der zu vergebende Nummern abgefragt werden.

Im Sheet "Nummer" ab Zelle A2 sollen die vergebene Nummer dokumentiert werden, im Sheet "Liste" sollen die vergebene Nummern aufgelistet werden.

mein bisheriger Code (ohne Erfolg) - ich hoffe ihr könnt mir hier weiterhelfen? fehlt die Prüfung des Duplikats und Fortsetzung bis 15 Nummern vergeben worden sind?

Dim a, b, c, z, Num1, Num2, NumA as String
a = InputBox(„Anzahl Nummer")
If a = "" Then Exit Sub
ActiveWorkbook.Sheets("Liste").Range("B2:B67000").ClearContents
For b = 1 To a
Num1 = ""
Num2 = ""
Num1 = Format(Int((9 * Rnd) + 1), "0")
Num2 = Format(Int((9999999 * Rnd) + 1), "0000000")
NumA = Num1 & Num2

‘?  Do While Not ? Is Nothing
‘?
‘?  Loop

ActiveWorkbook.Sheets("Liste").Range("B" & ActiveWorkbook.Sheets("Liste").Cells(Rows.Count, 2).End(xlUp).Row + 1).Value = NumA
Next b


Danke und LG

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zufällige/einmalige Nummernvergabe
28.03.2023 16:03:48
peterk
Hallo


Option Explicit
Sub CreateRND()

    Dim anz As Long
    Dim i As Long
    Dim Num As Long
    
    anz = Application.InputBox("Anzahl Nummern", , , , , , , 1)

    If TypeName(anz) = "Boolean" Then Exit Sub
    
    With ActiveWorkbook.Sheets("Liste")
        .Range("B2:B67000").ClearContents
        Do
            Num = WorksheetFunction.RandBetween(1, 9) * 10000000 + WorksheetFunction.RandBetween(1, 9999999)
            If WorksheetFunction.CountIf(.Range("B:B"), Num) = 0 Then
                .Range("B" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).Value = Num
                anz = anz - 1
            End If
        Loop Until anz = 0
    End With
End Sub

Peter


Anzeige
danke peterk :)
29.03.2023 10:47:03
Urmila
LG
Urmila


AW: Zufällige/einmalige Nummernvergabe
28.03.2023 16:08:07
Rudi Maintaire
Hallo,
Sub aaa()
  Dim a As Integer, b As Integer, NumA As Long
  
  a = Application.InputBox("Anzahl Nummern", , , , , , , Type:=1)
  If a = 0 Then Exit Sub
  
  ActiveWorkbook.Sheets("Liste").Range("B2:B67000").ClearContents
  
  Do While b  a
  
    Do
      NumA = WorksheetFunction.RandBetween(10000000, 99999999)
    Loop While WorksheetFunction.CountIf(Sheets("nummern").Columns(1), NumA) > 0
    
    Sheets("Liste").Cells(Rows.Count, 2).End(xlUp).Offset(1).Value = NumA
    Sheets("nummern").Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = NumA
    b = b + 1
    
  Loop
End Sub
Gruß
Rudi


Anzeige
AW: Zufällige/einmalige Nummernvergabe
29.03.2023 10:51:25
Urmila
Hallo lieber Rudi,

vielen Dank für den Lösungsvorschlag.
Eine Frage habe ich dennoch:

Ich habe jetzt zum Testen mal die Nummern bei "NumA" auf (1, 99) geändert.
Wenn hier jetzt die Zahlen bis 99 voll vergeben sind, läuft die Schleife (logischerweise) weiter und Excel stürzt ab.
Kann man das irgendwie abfangen z.B. mit einer Meldung und Abbruch?

Danke und LG
Urmila


AW: Zufällige/einmalige Nummernvergabe
29.03.2023 11:10:07
Rudi Maintaire
Hallo,
Sub aaa()
  Dim a As Integer, b As Integer, NumA As Long
  Dim lngFirst As Long, lngLast As Long
  Dim t As Double
  
  t = Timer
  
  lngFirst = 100
  lngLast = 999
  
  If Application.Count(Sheets("Nummern").Columns(1)) = lngLast - lngFirst + 1 Then
    MsgBox "Alle Nummern vergeben", , "gebe bekannt..."
    Exit Sub
  End If
  
  a = Application.InputBox("Anzahl Nummern", , , , , , , Type:=1)
  If a = 0 Then Exit Sub
  
  ActiveWorkbook.Sheets("Liste").Range("B2:B67000").ClearContents
  
  Do While b  a
  
    Do
      NumA = WorksheetFunction.RandBetween(lngFirst, lngLast)
      If Timer > (t + 10) Then Exit Sub 'nach 10 Sek. abbrechen
    Loop While WorksheetFunction.CountIf(Sheets("nummern").Columns(1), NumA) > 0
    
    Sheets("Liste").Cells(Rows.Count, 2).End(xlUp).Offset(1).Value = NumA
    Sheets("Nummern").Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = NumA
    b = b + 1
    
  Loop
End Sub
Gruß
Rudi


Anzeige
vielen lieben Dank Rudi :)
29.03.2023 11:21:51
Urmila
LG
Urmila

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige