Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Nummerierung mit VBA setzen





Frage

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

Antwort 1 von nighty

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

Antwort 2 von nighty

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

Antwort 3 von 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











Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: