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
Anzeige