Zeilen Nummerierung

Bild

Betrifft: Zeilen Nummerierung
von: erik
Geschrieben am: 23.02.2005 20:15:33
Hallo,
Ich hab da noch ein Problem !
Kennt jemand von Euch einen VBA-Code für eine fortlaufende Zeilen - Nummerierung ?
In meiner Tabelle "Türliste", soll die Nummmierung in Zelle "A20" mit 1 beginnen und in "A500" enden. Die Nummierung soll nur durchgeführt werden,
wenn in der jeweiligen Zeile ein Wert (Zahl o. Text) vorhanden ist.


Sub lfd_nr()
?
End Sub


erik
Bild

Betrifft: AW: Zeilen Nummerierung
von: Josef Ehrensberger
Geschrieben am: 23.02.2005 20:30:09
Hallo Erik!
Das lässt sich auch mit einer Formel lösen!
Wenn's aber VBA sein soll, dann kopiere diesen Code in das Modul der Tabelle!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, i As Integer
If Not Intersect(Target, Range("B20:IV500")) Is Nothing Then
On Error GoTo ERRORHANDLER
With Application
.EnableEvents = False      'Ereignisse ausschalten
.ScreenUpdating = False    'Bildschirmaktualisierung ausschalten
.Cursor = xlWait           'Cursor "ruhigstellen"
End With
Range("A20:A500") = ""  '"Alte" Nummereierung entfernen
   'Alle Zellen des Bereiches durchlaufen
   For Each rng In Range("A20:A500")
      'Nummerierung neu setzen
      If Application.CountA(Range(Cells(rng.Row, 2), Cells(rng.Row, 256))) > 0 Then
         i = i + 1
         Cells(rng.Row, 1) = i
      End If
      
   Next
End If
ERRORHANDLER:  'Fehlerbehandlung
With Application
.EnableEvents = True     'Ereignisse einschalten
.ScreenUpdating = True   'Bildschirmaktualisierung einschalten
.Cursor = xlDefault
End With
End Sub


Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
Bild

Betrifft: AW: Zeilen Nummerierung
von: erik
Geschrieben am: 23.02.2005 21:09:27
Hallo Josef,
Thanks,
Makro funktioniert tadellos,
ich hatte es schon mit einer Formel probiert,
aber dabei wird der Druckbereich sehr groß, kann man zwar auch einstellen...
Vielleicht kannst Du mir nochmal helfen.
Ich suche noch nach einen ähnlichen Code für die Formate:
Und zwar sollen in meiner Tabelle "Türliste", die Formate aus der Zeile "20" auf die Zeilen "21" bis "500" übertragen werden, und dass nur wenn in der jeweiligen Zeile ("21:500") ein Wert (Zahl o. Text) vorhanden ist.
Vielleicht hast Du eine Idee ?
Best regards from Meißen
Viele Gruesse aus Meißen
Erik Noack
Bild

Betrifft: AW: Zeilen Nummerierung
von: Uduuh
Geschrieben am: 23.02.2005 21:20:12
Hallo,
ungetestet, sollte aber klappen:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, i As Integer
If Not Intersect(Target, Range("B20:IV500")) Is Nothing Then
On Error GoTo ERRORHANDLER
With Application
.EnableEvents = False      'Ereignisse ausschalten
.ScreenUpdating = False    'Bildschirmaktualisierung ausschalten
.Cursor = xlWait           'Cursor "ruhigstellen"
End With
Range("A20:A500") = ""  '"Alte" Nummereierung entfernen
   'Alle Zellen des Bereiches durchlaufen
   For Each rng In Range("A20:A500")
      'Nummerierung neu setzen
      If Application.CountA(Range(Cells(rng.Row, 2), Cells(rng.Row, 256))) > 0 Then
         i = i + 1
         Cells(rng.Row, 1) = i
         Rows(20).Copy
         Cells(rng.Row,1).Pastespecial xlPasteFormats
      End If
      
   Next
End If
ERRORHANDLER:  'Fehlerbehandlung
With Application
.EnableEvents = True     'Ereignisse einschalten
.ScreenUpdating = True   'Bildschirmaktualisierung einschalten
.Cursor = xlDefault
End With
End Sub

Gruß aus'm Pott
Udo

P.S.Das Forum lebt auch von den Rückmeldungen an die Antworter.
Bild

Betrifft: AW: Zeilen Nummerierung
von: erik
Geschrieben am: 23.02.2005 21:38:33
Hallo Udo,
ich hab's getestet,
funktioniert bestens !
erik
Bild

Betrifft: AW: Zeilen Nummerierung
von: erik
Geschrieben am: 23.02.2005 21:58:39
Hallo Udo,
ich hab's nochmal getestet,
funktioniert bestens,
nur leider folgt der Programmabsturz bei aktiviereten Autofilter !
erik


Bild

Betrifft: AW: Zeilen Nummerierung
von: Josef Ehrensberger
Geschrieben am: 23.02.2005 23:31:16
Hallo Erik!
Da würde ich persönlich lieiber auf eine Formel zurückgreifen!
Aber das musst du selber wissen!
Hier der Code setzt den Autofilter vor der Nummerierung zurück.


      
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim i As Integer
If Not Intersect(Target, Range("B20:IV500")) Is Nothing Then
On Error GoTo ERRORHANDLER
With Application
.EnableEvents = 
False      'Ereignisse ausschalten
.ScreenUpdating = False    'Bildschirmaktualisierung ausschalten
.Cursor = xlWait           'Cursor "ruhigstellen"
End With
ActiveSheet.AutoFilterMode = 
False
Range(
"A20:A500") = ""  '"Alte" Nummereierung entfernen

   
'Alle Zellen des Bereiches durchlaufen
   For Each rng In Range("A20:A500")
      
'Nummerierung neu setzen
      If Application.CountA(Range(Cells(rng.Row, 2), Cells(rng.Row, 256))) > 0 Then
         i = i + 1
         Cells(rng.Row, 1) = i
         Rows(20).Copy
         Cells(rng.Row, 1).PasteSpecial xlPasteFormats
         Application.CutCopyMode = 
False
      
End If
      
   
Next
End If

ERRORHANDLER:  
'Fehlerbehandlung

With Application
.EnableEvents = 
True     'Ereignisse einschalten
.ScreenUpdating = True   'Bildschirmaktualisierung einschalten
.Cursor = xlDefault
End With
End Sub 

     Code eingefügt mit Syntaxhighlighter 3.0

Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
Bild

Betrifft: Zeilen Nummerierung mit dynamischem Druckmakro
von: Beate Schmitz
Geschrieben am: 23.02.2005 23:36:23
Hallo Udo,
mein Vorschlag: Nimm für die Zeilennummerierung doch eine Formel und füge als Ergänzung ein Druckmakro wie folgt ins Codefenster "dieseArbeitsmappe" ein:
Es passt den Druckbereich den sichtbaren Zellwerten an, also wenn Formeln drin sind, die kein Ergebnis bringen, werden diese Zellen nicht gedruckt. Hier das Makro sucht in Spalte A aufwärts nach der untersten zu druckenden Zelle. Der Druckbereich geht von A1 bis Spalte G, das musst du anpassen, ebenfalls den Tabellenblattnamen.
Testen kannst du über Seitenvorschau, dann springt das Makro auch an:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    If ActiveSheet.Name = "Tabelle1" Then
    Dim Loletzte As Long
    Dim LoI As Long
    Loletzte = 65536
    If [a65536] = "" Then Loletzte = [a65536].End(xlUp).Row
    For LoI = Loletzte To 2 Step -1
        If Cells(LoI, 11) <> Empty Then Exit For
    Next LoI
    ActiveSheet.PageSetup.PrintArea = "$A$1:$G$" & LoI
    End If
End Sub

Gruß,
Beate
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Zeilen Nummerierung"