Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

fortlaufende Nummerierung
#1
[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
Antworten Top
#2
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.
Gruß
Peter
[-] Folgende(r) 1 Nutzer sagt Danke an Peter für diesen Beitrag:
  • Mario
Antworten Top
#3
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
Gruß Stefan
Win 10 / Office 2016
[-] Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:
  • Mario
Antworten Top
#4
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
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
[-] Folgende(r) 1 Nutzer sagt Danke an RPP63 für diesen Beitrag:
  • Mario
Antworten Top
#5
Hi,

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

(26.12.2014, 02:13)Mario schrieb: 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
ABCDEFG
1DatumFeiertage VBAJahreszahleingabe
201.01.2015NeujahrDo 01.01.20152015Feiertage
302.01.2015Fr 02.01.201501.01.2015
403.01.2015Sa 03.01.2015
504.01.2015So 04.01.2015
605.01.2015Mo 05.01.2015
706.01.2015DreikönigDi 06.01.2015
807.01.2015Mi 07.01.201506.01.2015
908.01.2015Do 08.01.2015
1009.01.2015Fr 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.


.xlsm   Marios_Urlaubsplan_Test_VBA4.xlsm (Größe: 817,87 KB / Downloads: 11)
[-] Folgende(r) 1 Nutzer sagt Danke an Rabe für diesen Beitrag:
  • Mario
Antworten Top
#6
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
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 2 Gast/Gäste