Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Positionen automatisch generieren

Forumthread: Positionen automatisch generieren

Positionen automatisch generieren
23.11.2006 08:28:38
Gerhard
Hallo,
ich habe eine Tabelle in welcher in Spalte B fortlaufende Zahlen stehen. Die Spalte C soll mit den Positionen aufgefüllt werden.
Beispiel:
Spalte B
86
86
86
87
88
88
88
88
88
.
.
.
nun soll die Spalte C wie folgt gefüllt werden:
1
2
3
1
1
2
3
4
5
.
.
.
Kennt jemand ein Macro welches dies kann?
Danke für Eure Antwort
Gerhard
Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: Positionen automatisch generieren
23.11.2006 08:40:46
Harald
Moin Gerhard,
probiers mal so

Sub nummern()
Dim Lrow As Long, i As Long, wert As Long
Lrow = Cells(Rows.Count, 1).End(xlUp).Row
wert = 1
For i = 1 To Lrow
If Cells(i + 1, 1) = Cells(i, 1) Or Cells(i + 1, 1) = "" Then
Cells(i, 2) = wert
wert = wert + 1
Else
Cells(i, 2) = wert
wert = 1
End If
Next i
End Sub

Gruss Harald
Anzeige
AW: Positionen automatisch generieren
23.11.2006 08:46:01
Gerhard
Danke Harald, funktioniert super, habe nur die Spalten noch geändert und schon hats geklappt.
Gruß
Gerhard
Danke für die Rückmeldung owT
23.11.2006 08:47:19
Harald
Gruss Harald
AW: Positionen automatisch generieren
23.11.2006 09:38:31
Hugo
Hallo Harald,
bei großen Datenmengen besser ohne Schleife.

Sub durchnummerieren()
Dim startRow As Long
Dim lRow As Long
startRow = 1
lRow = Cells(Rows.Count, "B").End(xlUp).Row
Range("C" & startRow, "C" & lRow).Formula = _
"=COUNTIF(B$" & startRow & ":B" & startRow & ", B" & startRow & ")"
Range("C:C").Value = Range("C:C").Value
End Sub

Gruß Hugo
Anzeige
AW: Positionen automatisch generieren
23.11.2006 08:51:33
Engelbert
Hallo Gerhard,
probier's mal damit:

Sub ZeilenFüllen()
Dim Spalte As Long, lngR As Long
lngR = Range("B65536").End(xlUp).Row
Spalte = 2
Do Until Spalte = lngR + 1
If Not Range("B" & 1) = "" Then Range("C" & 1) = 1
If Range("B" & Spalte) = Range("B" & Spalte - 1) Then
Range("C" & Spalte) = Range("C" & Spalte - 1) + 1
Else
Range("C" & Spalte) = 1
End If
Spalte = Spalte + 1
Loop
End Sub

Schöne Grüße aus Nürnberg, Bert
Anzeige
Mist, Lösung schon vorhanden.. o.w.T
23.11.2006 08:52:28
Engelbert
Schöne Grüße aus Nürnberg, Bert
AW: Mist, Lösung schon vorhanden.. o.w.T
23.11.2006 08:55:28
Gerhard
Hallo Bert,
habe Deine Lösung auch probiert, funktioniert ebenfalls einwandfrei. Danke dafür
Ebenfalls schöne Grüße aus Ingolstadt
Gerhard
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige