Zufallsgenerator vs. Passwortgenerator

jerry0110

Erfahrenes Mitglied
Hi,

ich stehe vor volgender Herausvorderung.

Ich habe eine Tabelle mit Daten. Dort habe ich per Makro 3 Spalten erstellt. Suffix, Benutzername und Passwort.
In Suffix möchte ich per Zufall 3 willkürliche kleine Buchstaben haben. Der Benutzername soll der Suffix + die Kundennummer sein welche ich z.B. mit Verkettung eintragen kann. Das Passwort soll ein willkürliches Passwort mit 7 Zahlen und kleinen Buchstaben sein.

Habe im Netz jetzt auch mal nach Möglichkeiten gesucht. Welche nutzen einen Passwortgenerator und welche nutzen Zufallsgenerator durch eine Formel.

Code:
Option Explicit


Public Function machs(A As Integer) As String
Const strText As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!""§$%&()[]{}\?**#:;,.-+<>"
Dim B() As Byte
Dim Z As Integer
Dim I As Integer
Dim tmp
B = StrConv(strText, vbFromUnicode)
Randomize
For I = 0 To UBound(B)
    Z = Int(UBound(B) * Rnd)
    tmp = B(Z)
    B(Z) = B(I)
    B(I) = tmp
Next
machs = Left(StrConv(B, vbUnicode), A)
End Function

Das habe ich gefunden für einen Passwort Generator. Hier kann ich "Const strText As String" anpassen. Jedoch die Länge nicht.

Und ich stehe noch vor der Herausforderung, dass ich es nicht hinbekomme, die Formel so lange einzutragen bis die Zelle leer ist. Und er kopiert im Grunde nur die Formel und es ist immer das gleich Ergebnis.

Ich hoffe ich konnte ein wenig mein Problem erklären.
 

Yaslaw

n/a
Moderator
Also. Der Suffix ist einfach
Visual Basic:
'/**
' * Erstellt ein String mit 3 beliebigen kleinen Buchstaben (a-z)
' * @return String
' */
Public Function createSuffix() As String
    Const C_LOWER = 97      'asc("a")
    Const C_UPPER = 122     'asc("z")
    
    Dim ascii As Integer
    Dim i As Integer
    
    Randomize
    For i = 1 To 3
        'Ein Ascii-Wert eines kleinbuchstabens auswürfeln
        ascii = Int((C_UPPER - C_LOWER + 1) * Rnd + C_LOWER)
        'und in ein Buchstaben wandeln und an den bestehenden String anfügen
        createSuffix = createSuffix & Chr(ascii)
    Next i

End Function

Zum [Passwort]. Soll das generisch vergeben werden oder macht das der Benutzer?

Und zum [Benutzername]. Das ist nur ein zusammengesetzter Text. Den solltest du nicht speichern.
 

jerry0110

Erfahrenes Mitglied
Also das Passwort soll Generisch vergeben werden. 7-stellig mit kleinen buchstaben und Zahlen.
Und beim Benutzer mach ich das dann mit Verkettung oder? Macht doch am meisten Sinn.
 

Yaslaw

n/a
Moderator
Ein Generator fürs Passwort
Visual Basic:
'/**
' * Erstellt ein String mit 7 beliebigen kleinen Buchstaben (a-z) und Ziffern. ALs Erstes ist immer ein Buchstabe
' * @return String
' */
Public Function createPw() As String
    Const C_LOWER = 87          'asc("a") - 10
    Const C_LETTER_LOWER = 97   'asc("a")
    Const C_UPPER = 122         'asc("z")
    
    Dim ascii As Integer
    Dim i As Integer
    
    Randomize
    
    'Erstes Zeichen ein Buchstabe
    ascii = Int((C_UPPER - C_LETTER_LOWER + 1) * Rnd + C_LETTER_LOWER)
    createPw = Chr(ascii)
    For i = 2 To 7
        'Ein Ascii-Wert eines kleinbuchstabens auswürfeln
        ascii = Int((C_UPPER - C_LOWER + 1) * Rnd + C_LOWER)
        If ascii < C_LETTER_LOWER Then
        'Der Asciwert ist unter dem "a". Somit wird einfach die Differenz zum "a" berechnet um eine Ziffer zu bekommen
            createPw = createPw & CStr(C_LETTER_LOWER - 1 - ascii)
        Else
        'und in ein Buchstaben wandeln und an den bestehenden String anfügen
            createPw = createPw & Chr(ascii)
        End If
    Next i

End Function

Und jepp, mit Verkettung
In der Abfrage
SQL:
[suffix] & [kundennummer]
 

jerry0110

Erfahrenes Mitglied
Ich könnte doch jetzt die beiden "[suffix] & [kundennummer] in eine Variable packen und dann anfangen mit einer if schleife die Zellen mit der Variablen zu füllen oder?

Oder lieber mit der Abfrage erstmal füllen und dann verketten?

Code:
Option Explicit
Private Sub sufix
Dim KeyCells As Range
Set KeyCells = Range("sufix")
  If Not Application.Intersect(KeyCells,
Columns("A:A")(Target.Address)) _
        Is Nothing Then
        
      If Target <> "" Then
      sufix
      End If
  End If
End Sub

und dann mit dem Code verketten.

Code:
Sheets("Bearbeitet").Range("sufix").TEXT = "!" & Sheets("Bearbeitet").Range("Kundennummer")
 

jerry0110

Erfahrenes Mitglied
Sorry der Code ist falsch

Code:
Sheets("Bearbeitet").Range("sufix").TEXT = & Sheets("Bearbeitet").Range("Kundennummer").TEXT
 

Yaslaw

n/a
Moderator
Upps. Ist ja Excel und nicht Access. Dann macht die Benutzerspalte wohl Sinn.

Dein Macro sieht irgendwie falsch aus.

Ich habe mal ein Beispiel gemacht, mit den 4 Spalten
2016-01-13_124222.jpg

Und der folgende Code
Visual Basic:
Public Sub fillFields1()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim rowNr As Long
   
    Set ws = ActiveSheet
   
    lastRow = ws.Range("A1").SpecialCells(xlLastCell).Row
    Dim r As Range

    For rowNr = 2 To lastRow
        ws.Cells(rowNr, 2).Value = createSuffix
        ws.Cells(rowNr, 3).FormulaR1C1 = "=R[0]C[-2] & R[0]C[-1] "
        ws.Cells(rowNr, 4).Value = createPw
    Next
   
    Set ws = Nothing
End Sub

Am Ende siehts dann so aus
2016-01-13_124451.jpg
 

jerry0110

Erfahrenes Mitglied
Das klappt alles. Das einzige was nicht klappt ist das der Sufix und die Kundennummer sich verbinden.
Das liegt aber daran, dass die Kundennummer nicht in Spalte 1 ist sondern in unterschiedlichen Spalten sein kann. Kommt auf den Datenbestand an.

Dazu kommt noch, wenn ich dann die 3 Zeilen einfüge und dann die Daten befülle mit Sufix und Passwort klappt das. Wenn ich dann aber danach die spalten in ein anderes arbeitsblatt kopiere dann verkettet er falsch.
 
Zuletzt bearbeitet:

Yaslaw

n/a
Moderator
Dann musst du doch den Inhalt hineinkopieren und nicht die Formel.
Excel ist halt immer noch sehr ungeeignet um sauber mit Daten zu arbeiten.
 

jerry0110

Erfahrenes Mitglied
Ich habe deine Vorlage genommen und angepasst an meine Arbeitsblätter:

Code:
Public Sub KopierenRegistrierung()

Dim wsNew As Worksheet
Dim WkSh_Q As Worksheet
Dim WkSh_Z As Worksheet
Dim rZelle As Range
Dim aUeberschr As Variant
Dim iIndx As Integer
Dim iSpalte As Integer

Set wsNew = Worksheets.Add
With wsNew
   .Name = "Registrierung"
   .Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Nothing

aUeberschr = Array("Kundennummer", "Benutzername", "Passwort", "Ansprechpartner_VORNAME", "Ansprechpartner_NAME")

Application.ScreenUpdating = False

Set WkSh_Q = Worksheets("Bearbeitet") ' das Quell-Tabellenblatt
Set WkSh_Z = Worksheets("Registrierung") ' das Ziel-Tabellenblatt

With WkSh_Q.Rows(1)
For iIndx = 0 To UBound(aUeberschr)
Set rZelle = .Find(aUeberschr(iIndx), LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
iSpalte = iSpalte + 1
WkSh_Q.Columns(rZelle.Column).Copy Destination:=WkSh_Z.Columns(iSpalte)
End If
Next iIndx
End With

Application.ScreenUpdating = True

Code:
WkSh_Q.Columns(rZelle.Column).Copy Destination:=WkSh_Z.Columns(iSpalte)

das ist ja die entscheidene Stelle, wo etwas kopiert wird.
Heißt ja für mich laien der Code müsste mit Value versehen werden.

Code:
WkSh_Q.Columns(rZelle.Column).Copy.Value Destination:=WkSh_Z.Columns(iSpalte).Value

Klappt aber nicht. :) War ja zu erwarten.

Über suche habe noch gefunden, dass man folgende zufügen sollte, was aber auch nicht kappt:

Code:
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Application.CutCopyMode = False
 

Neue Beiträge