Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

einmalige Werte nummerieren

Forumthread: einmalige Werte nummerieren

einmalige Werte nummerieren
29.06.2013 13:18:49
Dennis

Hallo,
ich habe in meiner Tabelle folgende Werte in Spalte B und C stehen

WarentarifNo.	Bescheibung
27101999	Schmieröle und andere Zubereitungen
27101999	Schmieröle und andere Zubereitungen
32141010	Glaserkitt, Harzzement und andere Kitte
34029010	Grenzflächenaktive Zubereitungen, nicht in A
32141010	Glaserkitt, Harzzement und andere Kitte
27101999	Schmieröle und andere Zubereitungen
wie bringe ich Excel dazu, mir in Spalte A die Pos durchzunummerieren. Ergebnis soll sein:
Pos.	WarentarifNo.	Bescheibung
1	27101999	Schmieröle und andere Zubereitungen
1	27101999	Schmieröle und andere Zubereitungen
2	32141010	Glaserkitt, Harzzement und andere Kitte
3       34029010	Grenzflächenaktive Zubereitungen, nicht in A
2	32141010	Glaserkitt, Harzzement und andere Kitte
1	27101999	Schmieröle und andere Zubereitungen
Die Anzahl der Positionen ist bei 40 begrenzt. Die Anzahl der gefüllten Zeilen ist variabel
Würde mir jmd helfen?

Anzeige

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: einmalige Werte nummerieren
29.06.2013 13:45:07
hary
Moin Dennis
In A1 die Startnummer. Formel A2 runterkopieren so weit du brauchst.
Tabelle1
AW: einmalige Werte nummerieren
29.06.2013 13:49:57
Dennis
Vielen Dank Hary,
Das sieht vielversprechend aus. Gibt es auch eine VBA Lösung dafür?

AW: einmalige Werte nummerieren
29.06.2013 14:05:15
ransi
Hallo Dennis
"Aus der Hüfte":
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Sub machs()
    Dim arr As Variant
    Dim myDic As Object
    Dim L As Long
    Dim lngTMP As Long
    arr = Range("B2:B1000").Value 'Anpassen
    Redim out(1 To UBound(arr), 1 To 1)
    Set myDic = CreateObject("Scripting.Dictionary")
    For L = LBound(arr) To UBound(arr)
        If myDic.exists(arr(L, 1)) Then
            out(L, 1) = myDic(arr(L, 1))
            Else:
            lngTMP = lngTMP + 1
            myDic(arr(L, 1)) = lngTMP
            out(L, 1) = myDic(arr(L, 1))
        End If
    Next
    'Ausgeben
    Range("A2:A1000") = out 'Anpassen
End Sub


ransi

Anzeige
AW: einmalige Werte nummerieren
29.06.2013 14:16:55
Dennis
Hallo Ransi,
scheint zu funktionieren, allerdings steht nun in zeile 8 bis 1000 die Zahl 4 in Spalte A:(

AW: einmalige Werte nummerieren
29.06.2013 14:21:07
hary
Moin
Nicht schoen,aber...
Formel eintragen und Formel durch Wert ersetzen.
Dim letzte As Long
letzte = Cells(Rows.Count, 2).End(xlUp).Row
Cells(1, 1) = 1 'erste Zahl setzen
With Range(Cells(2, 1), Cells(letzte, 1))
.FormulaLocal = "=WENN(B2="""";"""";WENNFEHLER(INDEX($A$1:A1;VERGLEICH(B2;$B$1:B1;0));MAX($A$1: _
A1)+1))"
.Value = .Value
End With

gruss hary

Anzeige
AW: einmalige Werte nummerieren
29.06.2013 14:33:25
Dennis
Ich habe mir mal ransi Makro selbst angepasst.
nun funktionierts wunderbar. Danke
Sub machs()
Dim lastrow As Integer
Dim arr As Variant
Dim myDic As Object
Dim L As Long
Dim lngTMP As Long
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
arr = Range(Cells(2, 2), Cells(lastrow, 2)).Value 'Anpassen
ReDim out(1 To UBound(arr), 1 To 1)
Set myDic = CreateObject("Scripting.Dictionary")
For L = LBound(arr) To UBound(arr)
If myDic.exists(arr(L, 1)) Then
out(L, 1) = myDic(arr(L, 1))
Else:
lngTMP = lngTMP + 1
myDic(arr(L, 1)) = lngTMP
out(L, 1) = myDic(arr(L, 1))
End If
Next
'Ausgeben
Range(Cells(2, 1), Cells(lastrow, 1)) = out 'Anpassen
End Sub

Anzeige
Dim lastrow As Long...
29.06.2013 14:45:29
ransi
Hallo
...und es funktioniert auch bei mehr als 65536 Zeilen ;-)
ransi

AW: Dim lastrow As Long...
29.06.2013 16:27:21
Dennis
Nun wird es wirklich zu kompliziert für mich, aber ich bin so nah dran an meinem Ziel :)
Ich habe ransi´s Makro nun nochmalig angepasst. Habe aber nun ein neues Problem über das ich mir bisher nicht im Klaren war. Die Position wird mit ransi´s Makro tadellos vergeben. Allerdings müsste ich bei verschiedenen Warenursprüngen eine extra Position machen, obwohl die Warentarifnummer identisch ist... ich Weiß aber nicht wie ich das anstellen soll :(
in meinem Beispiel sieht man wie es aussehen muss...
Sub ransicode()
Dim lastrow As Integer
Dim arr As Variant
Dim myDic As Object
Dim L As Long
Dim lngTMP As Long
'Positionsnummer ermitteln Start
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range(Cells(2, 9), Cells(lastrow, 9)).Value 'Anpassen
ReDim out(1 To UBound(arr), 1 To 1)
Set myDic = CreateObject("Scripting.Dictionary")
For L = LBound(arr) To UBound(arr)
If myDic.exists(arr(L, 1)) Then
out(L, 1) = myDic(arr(L, 1))
Else:
lngTMP = lngTMP + 1
myDic(arr(L, 1)) = lngTMP
out(L, 1) = myDic(arr(L, 1))
End If
Next
'Ausgeben
Range(Cells(2, 8), Cells(lastrow, 8)) = out 'Anpassen
'Positionsnummer ermitteln Ende
End Sub

Zusammenfassung

Anzeige
2 Kriterien ins Dictionary
30.06.2013 10:51:57
ransi
Hallo
Da musst du dem Dictionary sagen das noch was berücksichtigt werden muss.
Dazu erstmal das Ausgangsarray vergrößern.
arr = Range(Cells(2, 1), Cells(lastrow, 9)).Value 'Anpassen

Dann die verschiedenen Kriterien verketten und dem Dictionary übergeben.
verkettete_Kriterien = arr(L, 4) & "DUMMY" & arr(L, 6)

Schau es dir mal an:
Tabelle1

Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige