AW: Jetzt aber...
27.07.2010 15:10:41
JogyB
Hallo Stefan,
hier nochmal der aktualisierte Code. Ich poste ihn hier, da ich hier nichts runterladen kann, Deine Datei also heute abend zu Hause anschauen werde. So habe ich ihn da gleich auch.
Private Sub Worksheet_Change(ByVal Target As Range)
Const ersteZeile = 2 ' erste Zeile mit Nummerierung
Const nrStellen = 2 ' wie viele Stellen für die Nummerierung
Const nrFormat = "##.##.##" ' Format der Nummerierung
Const startFormat = "##.##.00" ' Format eines Abschnittsbeginns
Dim zeLLe As Range
Dim pruefBereich As Range
Dim letzteZeile As Long ' letzte Zeile des Datenbereichs in Spalte 1
Dim starT As Long
Dim enDe As Long
Dim zeiLe As Long
Dim lfdNr As String
Dim upDate As Boolean
On Error GoTo errorHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
' zu prüfenden Bereich festlegen, d.h. Schnittmenge von Spalte 1 im Datenbereich
' mit den geänderten Zellen
letzteZeile = Cells(Rows.Count, 1).End(xlUp).Row
Set pruefBereich = Intersect(Target, Range(Cells(ersteZeile, 1), _
Cells(letzteZeile, 1)))
' zuerst Prüfungen, ob im relevanten Bereich
If Not pruefBereich Is Nothing Then
' Ob Zelle in erster Spalte leer
' das wird für jede geänderte Zelle im relevanten Bereich gemacht
For Each zeLLe In pruefBereich
' Prüfen, ob Update notwendig
' Fall 1: Es handelt sich um die erste Zelle
If zeLLe.Row = ersteZeile Then
' In dieser wird nur etwas gemacht, wenn ein 00-Wert
' eingetragen wurde. Ein solcher soll hier ja stehen
' dann nachfolgende Zelle updaten
If zeLLe Like startFormat Then
upDate = True
Set zeLLe = zeLLe.Offset(1, 0)
' Wenn nicht das Format eines Abschnittsbeginns,
' dann passiert nichts
Else
upDate = False
End If
' Fall 2: Zelle ist leer
ElseIf zeLLe.Value = "" Then
upDate = True
' Fall 3: in aktueller Zelle wurde xx.xx.00 eingetragen
ElseIf zeLLe.Value Like startFormat Then
' Wenn Nachfolgezelle nicht leer, dann ab dieser neu nummerieren
If zeLLe.Offset(1, 0) "" Then
upDate = True
Set zeLLe = zeLLe.Offset(1, 0)
' Ansonsten passiert nichts
Else
upDate = False
End If
' Fall 3: vorige oder nachfolgende Zelle haben nicht das korrekte Format
ElseIf Not (zeLLe.Offset(1, 0) Like nrFormat _
And zeLLe.Offset(-1, 0) Like nrFormat) Then
upDate = True
' Fall 5: vorige Zelle hat nicht eine um 1 kleinere Nummerierung
' und ist sonst gleich
ElseIf Not (Left(zeLLe, Len(nrFormat) - nrStellen) = _
Left(zeLLe.Offset(-1, 0), Len(nrFormat) - nrStellen) And _
CLng(Right(zeLLe, nrStellen) - 1) = _
CLng(Right(zeLLe.Offset(-1, 0), nrStellen))) Then
upDate = True
' Fall 6: nachfolgende Zelle hat nicht eine um 1 höhere nummerierung
' und ist sonst gleich und endet auch nicht auf 00
ElseIf Not (Left(zeLLe, Len(nrFormat) - nrStellen) = _
Left(zeLLe.Offset(1, 0), Len(nrFormat) - nrStellen) And _
CLng(Right(zeLLe, nrStellen)) + 1 = _
CLng(Right(zeLLe.Offset(1, 0), nrStellen))) _
And Not zeLLe.Offset(1, 0) Like startFormat Then
upDate = True
Else
upDate = False
End If
If upDate Then
' nach vorhergehender Zelle mit korrektem Format suchen
For starT = zeLLe.Row - 1 To ersteZeile Step -1
If Cells(starT, 1) Like nrFormat Then
Exit For
End If
Next
' kein 00 gefunden, also raus
If starT
Gruß, Jogy