vba fortlaufende Nummerierung bei gleichem Wert

[Harry2k]

Hallo,

gibt es eine Möglichkeit einer Nummerierung per vba die "ab einem geänderten Wert" oder ähnlichem arbeitet?
Ich habe eine Liste, hier sind Nummerierungen nötig (Vorgang_19) die sich aber wieder auf andere Werte beziehen (Kunde) also es viele variable Bereiche gibt. Wie kann ich das lösen, das ganze sollte nach Möglichkeit im VBA Teil passieren da es innerhalb eines Makros laufen soll.

Beispiel: Spalte A und B mit Bereichen (Kunden)

Vorgang_19	Kunde
1​	12345​
2​	12345​
3​	12345​
4​	12345​
5​	12345​
6​	12345​
7​	12345​
1​	12346​
2​	12346​
3​	12346​
4​	12346​
5​	12346​
6​	12346​
7​	12346​
8​	12346​
9​	12346​
10​	12346​
1​	12347​
2​	12347​
3​	12347​
4​	12347​
5​	12347​
6​	12347​
7​	12347​
8​	12347​
9​	12347​
10​	12347​
11​	12347​
12​	12347​
13​	12347​
14​	12347​

Falls jemand eine Idee hat ....


Gruß

Harry2k

 

[fuchen]

vielleicht habe ich das Problem nicht vollständig durchschaut (kann sehr gut sein), aber das lässt sich doch relativ einfach mit einer nach unten ausgefüllten Wenn-Schleife und ein paar Hilfszellen lösen

Version für Faule:
(Haken: die allererste Zeile muss selbst eingegeben werden)

=WENN(B3=B2;A2+1;"1")

Hier zum Testen: Test-Tabelle

Falls du was fancyges mit Scripten brauchst, bin ich raus... bin nur der Typ für die faulen Lösungen

 

[Scientist]

Da VBA keine Vektoroperationen kennt: Schleife ueber alle Eintraege und auf Aenderungen kontrollieren.
Vorher am besten die Daten in ein Array laden.

 

[Harry2k]

ja werde es wohl als Formel einbauen müssen , fast die gleiche hat fuchen gepostet,
=WENN(B2=B1;A1+1;"1"), vorher muss ich dann eben noch Kunden sortieren und im Nachgang die Formeln in Festwerte ändern. Werde mich aber alternativ mit der Schleife in vba mal dransetzen.

Danke erstmal!

 

[elnino460]

ja werde es wohl als Formel einbauen müssen , fast die gleiche hat fuchen gepostet,
=WENN(B2=B1;A1+1;"1"), vorher muss ich dann eben noch Kunden sortieren und im Nachgang die Formeln in Festwerte ändern. Werde mich aber alternativ mit der Schleife in vba mal dransetzen.

Danke erstmal!

Hey, ich weiß du hattest eigentlich schon eine Lösung aber ich hatte mich auch mal dran gemacht das Ganze in VBA zu realisieren. Lerne gerade ein bisschen mehr VBA und da kommen mir solche Beispiele immer gut gelegen Mit VBA müsstest du nicht die Formel soweit herunterziehen wie es Einträge gibt und du müsstest die Kunden nicht sortieren.

Ist eigentlich gar nicht so kompliziert:

Sub Main()

Dim dict As New dictionary

With Sheets("Tabelle1")
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row        ' wie oft die Schleife durchlaufen wird
        dictKey = .Cells(i, 1)                              ' Einträge in Vorgang_19 (Spalte 1)
        
        If Not dict.Exists(dictKey) Then                    ' wenn nicht im dictionary dann:
            dict.Add dictKey, 1                             ' Eintrag hinzufügen mit Value 1
            .Cells(i, 2) = dict(dictKey)                    ' Value in Wunschspalte (2) eintragen
            
        Else                                                ' wenn im dictionary dann:
            dict(dictKey) = dict(dictKey) + 1               ' Value um 1 erhöhen
            .Cells(i, 2) = dict(dictKey)                    ' neuen Value in Wunschspalte eintragen
        End If
    Next
End With

End Sub

 

[Harry2k]

Ganz ehrlich : Klasse. Wobei ich die Dictionary Geschichte nicht so ganz auf die Kette bekomme, im Grunde ist es wie ein Array?...und wozu dient "arrKey" ...seis drum interessant & hat mir weitergeholfen musste es aber etwas abändern weil die obige Version von dir bei mir nicht lief(falls für dich interessant):

Sub Main()

Dim dict
Set dict = CreateObject("Scripting.Dictionary")

With Sheets(1)
For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row ' wie oft die Schleife durchlaufen wird
dictKey = .Cells(i, 2) ' Einträge Kundennummer (Spalte 2)

If Not dict.Exists(dictKey) Then ' wenn nicht im dictionary dann:
dict.Add dictKey, 1 ' Eintrag hinzufügen mit Value 1
.Cells(i, 1) = dict(dictKey) ' Value in Wunschspalte (1) eintragen

Else ' wenn im dictionary dann:
dict(dictKey) = dict(dictKey) + 1 ' Value um 1 erhöhen
.Cells(i, 1) = dict(dictKey) ' neuen Value in Wunschspalte eintragen
End If
Next
End With

End Sub

 

[elnino460]

Ganz ehrlich : Klasse. Wobei ich die Dictionary Geschichte nicht so ganz auf die Kette bekomme, im Grunde ist es wie ein Array?...und wozu dient "arrKey"

Die Variable arrKey war nur ein Überbleibsel. Hatte es am Anfang mit einem Array versucht, klappte aber nicht Habe es dann später vergessen rauszulöschen. Ist jetzt oben im Post richtig.

Ein Array ist ja im Grunde genommen nur eine Liste und kann nur über den Index abgerufen werden. Bei einem Dictionary hast du Key Value Pairs, das heißt du kannst einem Key/Schlüssel einen zugehörigen Wert zuordnen z.B. Name:Alter oder wie in deinem Beispiel Kunde:Anzahl. Der Vorteil ist natürlich, dass du die Werte auch anhand des Keys abrufen kannst und auch einfacher ändern kannst z.B. mit dictionary["Müller"] = Wert

...seis drum interessant & hat mir weitergeholfen musste es aber etwas abändern weil die obige Version von dir bei mir nicht lief(falls für dich interessant):

Ups, das hatte ich ganz vergessen zu erwähnen. Man muss entweder den Verweis in VBA anmachen (VBA Menü -> Extras -> Verweise -> Microsoft Scripting Runtime) oder eben wie du es gemacht hast vorher extra deklarieren.