Anzeige
Archiv - Navigation
820to824
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
820to824
820to824
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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

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
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
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige