Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1320to1324
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
Inhaltsverzeichnis

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?

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

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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige