Supportnet / Forum / Tabellenkalkulation

Hallo zusammen, habe folgendes Problem: Ich habe ein Tabellenblatt mit Autozubehör; dieses hat folgenden Aufbau: Spalte A: Fortlaufende Nr von 1 bis Nr. des letzten Zubehörs. Spalte B: Hersteller Spalte C: Modell Spalte D: Fortlaufende Nr (aber nur von Anfang bis Ende des jeweiligen Modells Nun möchte ich über ein Makro die Nr in Spalte D automatisch setzen lassen bzw. wenn schon Nummern in Spalte D vorhanden sind, diese aufsteigend sortiren. Wichtig ist auch, dass die Nummerierung nur bis zum Ende des letzten Artikels geht. Zum besseren Verständnis hier eine Beispieldarstellung der Tabelle SpA SpB SpC SpD SpE 1 Opel Corsa 1 Anlasser 2 Opel Corsa 2 Bremsen 3 Opel Corsa 3 Spiegel 4 Opel Corsa 4 Zündkerzen 5 Opel Vectra 1 Anlasser 6 Opel Vectra 2 Rücklicht 7 Opel Vectra 3 Scheinwerfer 8 Opel Astra 1 Sitzbezug 9 Opel Astra 2 Temperaturfühler usw. Kann mir jemand sagen, ob so etwas möglich ist ? Gruß Klaus

hi klaus :)

vielleicht so :)

gruss nighty

Sub makro01()
For t = 1 To 2
Range("A:F").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
a% = 1
b% = 0
c% = 1
d% = 1
Do
If Range("B" & a%) = "" Then
Exit Do
Else
Range("A" & a%) = a%
End If
If a% > 1 Then
c% = a% - 1
Else
c% = 1
End If
If Range("C" & c%) <> Range("C" & a%) Then
Rows(d% & ":" & a% - 1).Select
Selection.Sort Key1:=Range("E1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
b% = 1
d% = a%
Range("D" & a%) = b%
Else
b% = b% + 1
Range("D" & a%) = b%
End If
a% = a% + 1
Loop
Next t
Range("A1").Select
End Sub

hi klaus :)

dies ist auch nur zur aufsteigenden sortierung der artikel und unterartikel wie der nummern und unternummern ,es veraendern sich natuerlich staendig die hauptnummern zum bezug der artikel,doch hielt ich mich somit an deiner beschreibung.

gruss nighty

hi alle

hier nochmal korrigiert und der rest geht per email.

gruss nighty

Sub makro01()
Dim a%, c%, d%
Range("A:F").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
a% = 1
c% = 1
d% = 1
Do
If Range("C" & a% + 1) <> Range("C" & a%) Then
d% = a%
Rows(d% & ":" & a% - 1).Select
Selection.Sort Key1:=Range("E" & d%), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
b% = 0
Else
If Range("C" & a%) = "" And Range("C" & a% + 1) = "" Then Exit Do
b% = b% + 1
Range("D" & a%) = b%
End If
a% = a% + 1
Loop
Range("A1").Select
End Sub

• Prüfung mit fortlaufender Nummerierung
• Anfangswert in einer Formel in Excel setzen ?
• Leerzeichen automatisch setzen
• Automatische Nummerierung in Excel
• Autofilter mit Makro setzen