Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
572to576
572to576
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zeilen Nummerierung

Zeilen Nummerierung
23.02.2005 20:15:33
erik
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

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeilen Nummerierung
23.02.2005 20:30:09
Josef
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!
Anzeige
AW: Zeilen Nummerierung
23.02.2005 21:09:27
erik
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
Anzeige
AW: Zeilen Nummerierung
Uduuh
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.
Anzeige
AW: Zeilen Nummerierung
23.02.2005 21:38:33
erik
Hallo Udo,
ich hab's getestet,
funktioniert bestens !
erik
AW: Zeilen Nummerierung
23.02.2005 21:58:39
erik
Hallo Udo,
ich hab's nochmal getestet,
funktioniert bestens,
nur leider folgt der Programmabsturz bei aktiviereten Autofilter !
erik


AW: Zeilen Nummerierung
23.02.2005 23:31:16
Josef
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 


Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
Anzeige
Zeilen Nummerierung mit dynamischem Druckmakro
Beate
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige