Worksheet Change - Nummerierung

29/09/2009 - 15:35 von Sonja Kober | Report spam
Hallo,

ich möchte folgendes realisieren: es gibt insgesamt 13 Tabellenblàtter. In
12 Tabellenblàttern (Jan bis Dez) steht in Spalte A steht von A6 bis A499 das
Datum.
Nun soll bei der ersten Eingabe in A6 (egal ob im Jan oder spàter) in B6 die
Nummer 1 stehen. Bei jeder weiteren Eingabe in Spalte A die Nummer um 1
erhöht werden. Die Erhöhung soll auch dann funktionieren, wenn zB im Feb
nichts steht sondern erst wieder im Màrz - es soll also immer die
letzte/höchste Nummer um 1 erhöht werden.

Ich habe hier schon eine àhnliche Funktion von Herbert Taferner, welche
funktiiniert, aber noch zusàtzlich die Belegart prüft. Also zB bei Belegart
KA beginnt die Nummerierung mit 1, bei einer neuen Belegart BK beginnt die
Nummerierung ebenfalls wieder mit 1.

Da diese Prüfung aber nicht notwendig ist habe ich im Code die Abfrage If
UCase(Beleg) = UCase(üBelegart) And _
.Cells(i, üSpalte + 1).Value <> "" Then
auskommentiert.

Dann funktioniert aber die Nummerierung nicht mehr.

Kann mir bitte jemand helfen.

Hier der Code:
Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo TreatErr
Dim Nr As Long
If Left(Target.Address, 2) = "$B" Then
'-> Anwender hat in Spalte B etwas geàndert
'-> Belegenr ermitteln
Nr = Ermittle_Belegenummer(Target.Value, Target.Row - 1, Target.Column)
'-> Nr in Zelle schreiben
If Nr > 0 Then
Cells(Target.Row, Target.Column + 1) = Nr
Else
If Trim(Target.Value) = vbNullString Then
'-> Anwender hat Eingabe wieder gelöscht
Cells(Target.Row, Target.Column + 1) = vbNullString
Else
'-> Bei einer Neueingabe (Belegart kommt noch nicht vor), 1 eintragen
Cells(Target.Row, Target.Column + 1) = 1
End If
End If
End If

TreatErr:
If Err = 13 Then 'bei Mehrfachmarkierung -> Fehler 13 -> Spalte rechts
daneben löschen
Range(Cells(Target.Row, Target.Column + 1), Cells(Target.Row +
Target.Rows.Count - 1, Target.Column + 1)).ClearContents
End If
End Sub


Function Ermittle_Belegenummer(ByVal üBelegart As String, _
ByVal üZeile As Long, ByVal üSpalte As Long) As Long

Dim i As Long
Dim Beleg As String
Dim Beleg_Nr As Long
Dim w As Long
Dim f As Long
f = 0

For w = Worksheets.Count To 1 Step -1
With Worksheets(w)

If Trim(üBelegart) <> vbNullString Then
üZeile = .Cells(Rows.Count, üSpalte).End(xlUp).Row
For i = üZeile To 1 Step -1
Beleg = .Cells(i, üSpalte).Value
If UCase(Beleg) = UCase(üBelegart) And _
.Cells(i, üSpalte + 1).Value <> "" Then
Beleg_Nr = .Cells(i, üSpalte + 1).Value
If f < Beleg_Nr Then f = Beleg_Nr
End If
Next
End If
End With
Next
Ermittle_Belegenummer = f + 1

End Function

Danke und LG, Joe
 

Lesen sie die antworten

#1 Andreas Killer
29/09/2009 - 16:23 | Warnen spam
Sonja Kober schrieb:

ich möchte folgendes realisieren: es gibt insgesamt 13 Tabellenblàtter. In
12 Tabellenblàttern (Jan bis Dez) steht in Spalte A steht von A6 bis A499 das
Datum.
Nun soll bei der ersten Eingabe in A6 (egal ob im Jan oder spàter) in B6 die
Nummer 1 stehen. Bei jeder weiteren Eingabe in Spalte A die Nummer um 1
erhöht werden. Die Erhöhung soll auch dann funktionieren, wenn zB im Feb
nichts steht sondern erst wieder im Màrz - es soll also immer die
letzte/höchste Nummer um 1 erhöht werden.


Wann ist denn die erste Eingabe in A6???? Naja, ist eigentlich egal
wenn B6 entweder leer oder 0 ist, da bei Eingabe in Spalte A (also
auch A6) immer B6¶+1 sein soll.

Der Code muss in das Codemodul der Mappe, wie's geht steht hier:
http://www.online-excel.de/excel/si....php?fD#s3

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
Dim R As Range
'Alle geànderten Bereiche einzeln durchlaufen
For Each R In Target
'Welche Spalte ist es?
Select Case R.Column
'Ist es Spalte A?
Case 1
'Ereignisse aus
Application.EnableEvents = False
'B6 um 1 erhöhen
Range("B6") = Range("B6") + 1
'Ereignisse an
Application.EnableEvents = True
End Select
Next
End Sub

Ich habe hier schon eine àhnliche Funktion von Herbert Taferner, welche


Die macht was ganz anderes als Du oben geschrieben hast.

Andreas.

Ähnliche fragen