Fortlaufende Nummer prüfen und nur einmal vergeben

Hallo !
Ich habe eine Excelmappe in der insgesamt 3 Blätter drinnen sind. Es gibt dabei eine "Eingangsliste" wo eine fortlaufende Nummerierung in Spalte B stattfindet. Aus dieser Eingangsliste werden bei Bedarf Zeilen in eine "Auftrag" und "Erledigt" Datei herausgelöscht und dort aufbewahrt. Nun bin ich gerade draufgekommen, daß wenn ich die fortlaufenden Nummern nicht mehr in der "Eingangsliste" habe, diese jedoch entweder in der "Auftrag" oder "Erledigt" Datei vorkommen, ich eine falsche fortlaufende Nummer eingebe. Nun zu meiner Frage:
Kann man mittels VBA prüfen ob die Nummer die vergeben wird schon vorkommt und dann die nächstmögliche ermittelt oder kann man mittels VBA die Antweisung erteilen, das die nächstmögliche Nummer, wenn man ein Datum in Spalte A eingibt, vergeben wird ?
Danke für eure Hilfe
chris

Hallo !
Ja, das ist das richtige, nur leider bin ich nicht fähig das in meine Datei reizukopieren. Ich nehme den Code aus Dok.Ink. und kopiere ihn in meine Datei Dok.Ink. .. doch da geht der Code dann nicht
lg
chris
So hab ich den Code kopiert in Dok.Ink. muß ich noch woanders eine Änderung vornehmen ?


Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow     As Long
Dim sSheet   As String
Dim iLfd_Nr  As Integer
If Target.Column = 2 And Target.Row > 3 And Target.Rows.Count = 1 Then
If Target.Value > WorksheetFunction.Max(Range("B3:B" & Target.Row - 1)) Then
If Application.WorksheetFunction.CountIf(Worksheets _
("Neuwagen-Finanzierung").Range("B3:B1000"), Target.Value)  0 Or _
Application.WorksheetFunction.CountIf(Worksheets _
("Erledigt").Range("B3:B1000"), Target.Value)  0 Then
MsgBox "Die eingetragene laufende Nummer  """ & Target.Value & _
"""  gibt es bereits - bitte eine neue Nummer eingeben.", _
48, "   Hinweis für " & Application.UserName
Target.Value = ""
Cells(Target.Row, 2).Select
Exit Sub
End If
End If
End If
If Not ((Target.Column = 9 Or Target.Column = 10) And _
Target.Row > 3 And Target.Rows.Count = 1) Then GoTo leave_sub
On Error GoTo leave_sub
Application.EnableEvents = False
If IsDate(Target) Then ' Abfrage, ob Datum
sSheet = IIf(Target.Column = 9, "Erledigt", "Neuwagen-Finanzierung")
lRow = Sheets(sSheet).Range("A" & Sheets(sSheet).Rows.Count).End(xlUp).Row + 1
ActiveSheet.Range(Cells(Target.Row, 1), Cells(Target.Row, 10)).Copy
Sheets(sSheet).Cells(lRow, 1).PasteSpecial Paste:=xlPasteValues
If sSheet = "Erledigt" Then
Sheets(sSheet).Cells(lRow, 1).PasteSpecial Paste:=xlPasteFormats
ActiveSheet.Cells(Target.Row, 1).EntireRow.Delete (xlUp)
Sheets(sSheet).Cells(lRow, 11) = Date
MsgBox "Wurde in die Datei [Erledigt] kopiert" & vbCrLf & _
"und in der Datei [Dok.Ink] gelöscht!", _
vbOKOnly + vbInformation, "Erledigen"
Else
Sheets(sSheet).Cells(lRow, 11).Value = Date
MsgBox "Datensatz wurde in Datei [" & sSheet & "] kopiert!", _
vbOKOnly + vbInformation, "Kopieren"
End If
End If
leave_sub:
Application.EnableEvents = True
End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("C4:C5000")) Is Nothing Then
Sheets("Quittung").Range("D7").Value = Target.Value
End If
End Sub

Fortlaufende Nummer prüfen und nur einmal vergeben

Forumthread: Fortlaufende Nummer prüfen und nur einmal vergeben

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial