fortlaufende Nummerierung

[Mario]

[attachment=1055]

Hallo zusammen,

in meiner Datei habe ich eine UF, mit der ich Daten in ein Tabellenblatt schreibe.
Der Namen wird zum Beispiel in die Spalte B geschrieben. Nun möchte ich, dass jeder neue Eintrag eine lfd. Nummer erhät. Das habe ich auch mit folgenden Code hinbekommen.

[ActiveSheet.[A7] = 0
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Select
ActiveCell.Offset(1, 0) = ActiveCell + 1]

[TextBox6.SetFocus]

Wenn ich diesen Datensatz aber nun lösche, aktualisieren sich die laufenden Nummern in der Spalte A nicht. (wenn ich von vier Datensätzen den dritten lösche, ist die Reihenfolge 1,2,4).

Ist es möglich, dass die Nummerierung sich automatisch aktualisiert.

Danke und VG Mario

[Peter]

Hallo,

in der Tabelle scheint ein Blattschutz enthalten zu sein, so dass ich es nicht ausprobieren konnte.

Ich würde in in A8 einfach folgende Formel schreiben:

=Wenn(B8<>"";Max(A$7:A7)+1;"")

und diese Formel einfach nach unten kopieren.

[Steffl]

Hallo Mario,

das Selektieren ist meistens überflüssig.

Code:

Sub prcX()
   Dim lngLastRow As Long
  
   With ActiveSheet
      .Unprotect Password:="9010ml"
      lngLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
      .Cells(8, 1).Resize(lngLastRow - 7).Formula = "=row()-7"
      .Cells(8, 1).Resize(lngLastRow - 7).Value = .Cells(8, 1).Resize(lngLastRow - 7).Value
      .Protect Password:="9010ml"
   End With
End Sub

[RPP63]

Hallo!
Das Kennwort lautet "9010ml" (steht im Code).

Prinzipiell:
Die Mappe bremst den Rechner ziemlich aus.
Trotz Speicherbelegung von "nur" 39 MB treibt die bloße Bewegung zw. leeren Zellen mittels Cursortasten die Prozessorlast auf 30%.
Ist aber kein Wunder ...
Schau Dir mal Dein Worksheet_SelectionChange im Blatt Mitarbeiter an ...
(da werden u.a. bei jeder neuen Zellauswahl diverse Matrixformeln per Code eingetragen)
Außerdem brauchst Du nicht immer wieder den Schutz per Code ein- und auszuschalten.
Da reicht ein einfaches:

Code:

ActiveSheet.Protect Password:="9010ml", UserInterfaceOnly:=True

im Workbook_Open

Gruß, Ralf

[Rabe]

Hi,

vorab: zum Testen ist das mit dem Passwortschutz und der dauernd aufpoppenden Passwort-Abfrage extrem nervig!

in meiner Datei habe ich eine UF, mit der ich Daten in ein Tabellenblatt schreibe.
Der Namen wird zum Beispiel in die Spalte B geschrieben.

Du hast zwei Mal die Feiertage-Makros drin und in denen ist auch noch ein Fehler enthalten: der Karfreitag ist nicht 3 sondern nur 2 Tage vor Ostersonntag!
Also:
varDates(2, 0) = dEaster - 2
varDates(2, 1) = "Karfreitag"

Fragen und Tipps:
In den Formeln tauchen ein paar #Wert!-Fehler auf. Dann müssen in den Bezugszellen die Inhalte gelöscht werden, die scheinen leer zu sein, sind es aber nicht.
Warum entschützt Du die Blätter, bevor Du die Passwortabfrage startest?
Wenn das Passwort falsch ist, passiert gar nichts und der Anwender wundert sich, darum MessageBox.
Variablen-Dimensionierung immer zwischen Sub-Kopf und Codezeilen.

Also statt

Code:

Private Sub CommandButton29_Click()
   ActiveSheet.Unprotect Password:="9010ml"
  
   ' Passwortabfrage
   Dim Passwort As String
   Passwort = InputBox("Darfst Du das überhaupt?", "Passwort-Abfrage", "")
   If Passwort <> "9010ml" Then Exit Sub
  
   Application.DisplayFullScreen = True
  
   ActiveSheet.Protect Password:="9010ml"
End Sub

lieber so

Code:

Private Sub CommandButton29_Click()
   ' Passwortabfrage
   Dim Passwort As String
  
   Passwort = InputBox("Darfst Du das überhaupt?", "Passwort-Abfrage", "")
   If Passwort <> "9010ml" Then
      MsgBox ("Passwort falsch")
      Exit Sub
   End If
   ActiveSheet.Unprotect Password:="9010ml"
  
   Application.DisplayFullScreen = True
  
   ActiveSheet.Protect Password:="9010ml"
End Sub

Mit dem Folgenden wird nicht die Fehlerbehandlung eingeschaltet, sondern Fehler einfach ohne Behandlung übersprungen!

Code:

'Fehlerbehandlung einschalten
   On Error Resume Next

Wenn Du die Makros übersichtlicher haben willst, dann entferne die unzähligen Leerzeilen zwischen Erklärungszeilen und zugehörigen Codezeilen und anstatt 2-x Leerzeilen reicht auch eine.

Im Blatt 'Feiertage' sind einige '#Bezug!'-Fehler in den Namensdefinitionen! Hier noch ein paar Formeln für dieses Blatt:

Feiertage

	A	B	C	D	E	F	G
1	Datum	Feiertage VBA		Jahreszahleingabe
2	01.01.2015	Neujahr	Do 01.01.2015	2015			Feiertage
3	02.01.2015		Fr 02.01.2015				01.01.2015
4	03.01.2015		Sa 03.01.2015
5	04.01.2015		So 04.01.2015
6	05.01.2015		Mo 05.01.2015
7	06.01.2015	Dreikönig	Di 06.01.2015
8	07.01.2015		Mi 07.01.2015				06.01.2015
9	08.01.2015		Do 08.01.2015
10	09.01.2015		Fr 09.01.2015

verwendete Formeln
Zelle	Formel	Bereich	N/A
A2	=DATWERT("01.01."&$D$2)
A3:A10	=A2+1
B2:B10	=WENNFEHLER(SVERWEIS(A2;$I$1:$J$15;2;0);"")
C2:C10	=A2
G3:G10	=WENN(B2<>"";A2;"")

definierte Namen
Name	Bezieht sich auf	Tabelle	Z1S1-Formel
j	=#BEZUG!#BEZUG!		=#REF!#REF!

Excel-Inn.de

Hajo-Excel.de

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 18.19 einschl. 64 Bit

Du läßt in der Tabelle "Mitarbeiter" ein paar Formeln per Makro eintragen, hast aber schon die halbe Tabelle mit Formeln ausgefüllt. Das macht die Tabelle wahnsinnig groß und zeitaufwendig.
Warum läßt Du nicht gleich alle benötigten Formeln per Makro nur in den ausgefüllten Zeilen (überall, wo in Spalte B ein Name steht) eintragen?

Und diese Aktion anstelle von "Worksheet_SelectionChange" nur bei "Worksheet_Change"?

Code:

'#######################################################################################################################################################
' eingepflegte Formeln über FormulaLocal. Somit können die Formeln nicht vom Anwender aus der Zelle gelöscht werden
'#######################################################################################################################################################
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim loLetzte As Long
   Dim i As Long
  
   loLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count)
   On Error Resume Next
   Application.EnableEvents = False
  
   For i = 8 To loLetzte
      ' los gehts mit den Formeln in den Stammdaten :-))
      ' errechnet Urlaub aus Januar bis Dezember in den Stammdaten
      Range("I" & i).FormulaLocal = "=BG" & i   'Januar
      Range("J" & i).FormulaLocal = "=CV" & i   'Februar
      Range("K" & i).FormulaLocal = "=EK" & i   'März
      Range("L" & i).FormulaLocal = "=FZ" & i   'April
      Range("M" & i).FormulaLocal = "=HO" & i   'Mai
      Range("N" & i).FormulaLocal = "=JC" & i   'Juni
      Range("O" & i).FormulaLocal = "=KR" & i   'Juli
      Range("P" & i).FormulaLocal = "=MG" & i   'August
      Range("Q" & i).FormulaLocal = "=NU" & i   'September
      Range("R" & i).FormulaLocal = "=PJ" & i   'Oktober
      Range("S" & i).FormulaLocal = "=QX" & i   'Novemaber
      Range("T" & i).FormulaLocal = "=SM" & i   'Dezember
      
      ' errechnet den Gesamturlaub für´s aktuelle Jahr in Stammdaten
      Range("G" & i).FormulaLocal = "=Summe(I" & i & ":T" & i & ")"
      
      ' errechnet Resturlaub aus dem aktuellem Jahr in den Stammdaten
      Range("H" & i).FormulaLocal = "=F" & i & "-G" & i
      Range("W" & i).FormulaLocal = "=F" & i & "-G" & i
      
      '#######################################################################################################################################################
      ' weiter geht es mit den Formel im Januar :-)))
      ' Formel fest eingetragen, errechnet Urlaub "U" ganze Tage
      Range("BC" & i).FormulaLocal = "=SUMMENPRODUKT((X" & i & ":BB" & i & "=""U"")*(WOCHENTAG($X$3:$BB$3;2)<6)*(ISTFEHLER(VERGLEICH($X$3:$BB$3;Feiertage;0)))*1)"
      
      ' Formel fest eingetragen, errechnet Urlaub "½ U" halber Tag
      Range("BD" & i).FormulaLocal = "=SUMMENPRODUKT((X" & i & ":BB" & i & "=""½"")*(WOCHENTAG($X$3:$BB$3;2)<6)*(ISTFEHLER(VERGLEICH($X$3:$BB$3;Feiertage;0) ))*0,5)"
      
      ' Formel fest eingetragen, errechnet freie Tage "JAZ" ganze Tage
      Range("BE" & i).FormulaLocal = "=SUMMENPRODUKT((X" & i & ":BB" & i & "=""JAZ"")*(WOCHENTAG($X$3:$BB$3;2)<6)*(ISTFEHLER(VERGLEICH($X$3:$BB$3;Feiertage;0) ))*1)"
      
      ' Formel fest eingetragen, errechnet Urlaubsplanung "UP" ganze Tage
      Range("BF" & i).FormulaLocal = "=SUMMENPRODUKT((X" & i & ":BB" & i & "=""UP"")*(WOCHENTAG($X$3:$BB$3;2)<6)*(ISTFEHLER(VERGLEICH($X$3:$BB$3;Feiertage;0) ))*1)"
      
      '  Summen aus Januar
      '  errechnet Gesamturlaub Januar
      Range("BG" & i).FormulaLocal = "=BC" & i & "+BD" & i
      
      '  errechnet Summe aus aktuellem Jahr
      Range("BH" & i).FormulaLocal = "=BG" & i
      
      '  errechnet den Resturlaub aus dem aktuellem Jahr
      Range("BI" & i).FormulaLocal = "=W" & i & "-BH" & i
      
      '#######################################################################################################################################################
      ' weiter geht es mit dem Februar :-)))
      ' Formel fest eingetragen, errechnet Urlaub "U" ganze Tage
      Range("CR" & i).FormulaLocal = "=SUMMENPRODUKT((BM" & i & ":CN" & i & "=""U"")*(WOCHENTAG(BM$3:CN$3;2)<6)*(ISTFEHLER(VERGLEICH(BM$3:CN$3;Feiertage;0)))*1)"
      
      ' Formel fest eingetragen, errechnet Urlaub "½ U" halber Tag
      Range("CS" & i).FormulaLocal = "=SUMMENPRODUKT((BM" & i & ":CN" & i & "=""½"")*(WOCHENTAG(BM$3:CN$3;2)<6)*(ISTFEHLER(VERGLEICH(BM$3:CN$3;Feiertage;0) ))*0,5)"
      
      ' Formel fest eingetragen, errechnet freie Tage "JAZ" ganze Tage
      Range("CT" & i).FormulaLocal = "=SUMMENPRODUKT((BM" & i & ":CN" & i & "=""JAZ"")*(WOCHENTAG(BM$3:CN$3;2)<6)*(ISTFEHLER(VERGLEICH(BM$3:CN$3;Feiertage;0) ))*1)"
      
      ' Formel fest eingetragen, errechnet Urlaubsplanung "UP" ganze Tage
      Range("CU" & i).FormulaLocal = "=SUMMENPRODUKT((BM" & i & ":CN" & i & "=""UP"")*(WOCHENTAG(BM$3:CN$3;2)<6)*(ISTFEHLER(VERGLEICH(BM$3:CN$3;Feiertage;0) ))*1)"
      
      '  Summen aus Februar
      '  errechnet Gesamturlaub Februar
      Range("CV" & i).FormulaLocal = "=CR" & i & "+CS" & i
      
      '  errechnet Summe aus aktuellem Jahr
      Range("CW" & i).FormulaLocal = "=CV" & i
      
      '  errechnet den Resturlaub aus dem aktuellem Jahr
      Range("CX" & i).FormulaLocal = "=W" & i & "-CW" & i
      
      '  Übertrag in März
      Range("DA" & i).FormulaLocal = "=CX" & i
      
      '#######################################################################################################################################################
      ' weiter geht es mit dem März :-)))
      '...

   Next
   Application.EnableEvents = True
End Sub

Es ist vermutlich auch noch viiiel schneller, wenn es nur auf die aktuelle Zeile (die, in der etwas geändert wurde) bezogen wird.
Also statt der For-Next-Schleife "i = ActiveCell.Rows" oder so.


  Marios_Urlaubsplan_Test_VBA4.xlsm (Größe: 817,87 KB / Downloads: 11)

[Mario]

Hallo zusammen,

vielen Dank für eure schnelle Hilfe :23:. Ich bin froh das es euch gibt.
Ich werde die ganzen Hinweise sofort umsetzen.

Danke und VG Mario