statt höchste Zahl die erste freie Zahl
09.07.2018 23:13:39
Sabrina
mit dem Folgenden Marko wird nach der höchsten Kundennummer gesucht. (Spalte A)
Dann in der ersten freien Zeile Max+1 eingetragen und die Werte geschrieben.
Nun sind aber viele Kundennnummern gelöscht worden.
Was muss ich tun das in der ersten leeren Zeile die erste nicht vergebene Nummer vergeben wird.
Also in
A1 = 110001
A2 = 110003
A3 = 110004
A4 = 110005
Nun soll in A5 110002 geschrieben werden
Liebe Grüße Sabbel
Sub Kunde_speichern()
Dim KdMax As Long
Dim KdMin As Long
Dim KdNr As Long
Application.ScreenUpdating = False
Windows("Kunden.xls").Activate
Sheets("Kundenstamm").Select
Range("KundenNummer").Select
KdMax = Application.WorksheetFunction.Max(Range("A:A"))
KdMin = Application.WorksheetFunction.Min(Range("A:A"))
Windows("Eingabe.xls").Activate
Sheets("Eingabe Endkunde").Select
spe1 = Range("spe1")
Nachname = Range("Nachname")
Vorname = Range("Vorname")
spe4 = Range("spe4")
spe5 = Range("spe5")
spe22 = Range("spe22")
spe6 = Range("spe6")
spe7 = Range("spe7")
spe116 = Range("spe116")
kontakt2 = Range("kontakt2")
kontakt3 = Range("kontakt3")
Annahmestelle = Range("Annahme")
ust_id = Range("ust_id")
If Range("KundenNr") = "" Then
KdNr = KdMax + 1
Else
KdNr = Range("KundenNr")
End If
Windows("Kunden.xls").Activate
Sheets("Kundenstamm").Select
Range("KundenNummer").Select
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 1) = KdNr Then
Cells(i, 1).Select
GoTo weiter
End If
Next
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Select 'letzte leere zelle
GoTo weiter
weiter:
ActiveCell.Select
ActiveCell = KdNr
Selection.Offset(0, 1) = spe1
Selection.Offset(0, 2) = Nachname
Selection.Offset(0, 3) = Vorname
Selection.Offset(0, 4) = spe4
Selection.Offset(0, 5) = spe5
Selection.Offset(0, 6) = spe22
Selection.Offset(0, 7) = spe6
Selection.Offset(0, 8) = spe7
Selection.Offset(0, 9) = spe116
Selection.Offset(0, 10) = kontakt2
Selection.Offset(0, 11) = ust_id
Selection.Offset(0, 12) = kontakt3
Selection.Offset(0, 13) = Annahmestelle
ActiveWorkbook.Save
Windows("Eingabe.xls").Activate
Sheets("Eingabe Endkunde").Select
Range("KundenNr") = KdNr
Range("speicher") = "Daten gespeichert"
Application.GoTo Reference:="spe8"
Windows("Kunden.xls").Visible = False
End Sub