Registriert seit: 17.02.2018
Version(en): 2016
18.02.2018, 11:40
(Dieser Beitrag wurde zuletzt bearbeitet: 18.02.2018, 12:20 von WillWissen.
Bearbeitungsgrund: Formatierung
)
Hallo, ich brauche bitte eure Hilfe. Ich habe eine Tabelle in der die Codes für Produkte gelistet sind. Aus diesen Codes werden Dokumentennummern kreiert, die einzigartig sein müssen. Die Dokumentennummer ist folgendermaßen aufgebaut: DOC-Code1_Code2 (kann aus beliebig vielen Codes bestehen) Gibt es von einem Dokument mehrere Varianten, dann wird eine Nummerierung angefügt (z.B.: DOC-Code1_Code2-01, DOC-Code1_Code2-02, etc). Ich habe zum besseren Verständnis ein Beispieldokument angefügt. Im Tabellenblatt “DocNo“ sollen in Zelle B1 über ein Dropdown mit Mehrfachauswahl die Codes ausgewählt werden. Das mit der Mehrfachauswahl habe ich Dank eines Beispiels aus dem Internet noch hinbekommen. Aber weiter komme ich jetzt nicht mehr. Die ausgewählten Codes in B1 sollen aufsteigend sortiert werden (dh. nicht 35075_16384_35209, sondern 16384_35075_35209) und die Bezeichnung “DOC-“ soll noch vor die Codes gestellt werden. Dann soll geprüft werden, ob diese Dokumentennummer bereits vergeben wurde. Wenn nein, dann soll die Dokumentennummer in die Tabelle übernommen werden (im Bsp. in Zelle A11) und die Zelle B1 soll wieder leer sein. Wenn die Dokumentennummer bereits vorhanden ist, dann soll automatisch eine Nummerierung angefügt (-01, -02, …) werden und diese Dokumentennummer in die Tabelle übernommen werden. Ist so etwas in Excel möglich? Wenn ja, wie??? Leider kenne ich mich in Excel noch nicht so gut aus … :s Bin für jede Hilfe dankbar! LG
Einzigartige DokNr erzeugen.xlsm (Größe: 18,86 KB / Downloads: 10)
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallöchen, hier wäre mal ein erster Ansatz. Ich nutze im Code den Bereich der Spalte D zum sortieren - wenn der belegt ist, bitte andere Spalte programmieren. Code: Sub sortieren() 'Variablendeklaration 'Variant Dim arrCodes 'Aus Texteintrag in B1 array bilden arrCodes = Split(Cells(1, 2).Value, "_") 'Array ab D1 nach unten eintragen Range("D1").Resize(UBound(arrCodes) + 1, 1) = WorksheetFunction.Transpose(arrCodes) 'teilweise aufgezeichnet 'Sortieren zuruecksetzen ActiveWorkbook.Worksheets("DocNo").Sort.SortFields.Clear 'Im durch Array gefuellten Bereich von Spalte D sortieren ActiveWorkbook.Worksheets("DocNo").Sort.SortFields.Add Key:=Range("D1:D" & UBound(arrCodes) + 1), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal Sortierung anwenden With ActiveWorkbook.Worksheets("DocNo").Sort .SetRange Range("D1:D" & UBound(arrCodes) + 1) .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'String zusammensetzen arrCodes = "DOC-" & Join(WorksheetFunction.Transpose(Range("D1:D" & UBound(arrCodes) + 1)), "_") 'eingetragene Daten in D loeschen Range("D1:D" & UBound(arrCodes) + 1) = "" 'String als Meldung ausgeben MsgBox arrCodes End Sub
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 17.02.2018
Version(en): 2016
Guten Abend,
vielen Dank für die rasche Antwort!!
Ich habe deinen Code genommen und reinkopiert. Den Text "Sortierung anwenden" habe ich noch auskommentiert, ansonsten habe ich nichts verändert. Wenn ich auf Sub/UserForm ausführen gehe, kommt die Meldung "Laufzeitfehler 13: Typen unverträglich". Die Sortierung in Spalte D wird noch durchgeführt, und dann hängt es irgendwie. Habe ich da irgendwo was falsch gemacht, oder was bedeutet das?
LG
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
19.02.2018, 06:40
(Dieser Beitrag wurde zuletzt bearbeitet: 19.02.2018, 06:40 von schauan.)
Hallöchen,
Bei join oder später?
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 17.02.2018
Version(en): 2016
Guten Morgen,
ja, bei join.
LG
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallöchen, da war beim join schon das ubound... nicht mehr erreichbar Dann so: Code: Sub sortieren() 'Variablendeklaration 'Variant Dim arrCodes, iCnt% 'Aus Texteintrag in B1 array bilden arrCodes = Split(Cells(1, 2).Value, "_") 'Array ab D1 nach unten eintragen Range("D1").Resize(UBound(arrCodes) + 1, 1) = WorksheetFunction.Transpose(arrCodes) 'teilweise aufgezeichnet 'Sortieren zuruecksetzen ActiveWorkbook.Worksheets("DocNo").Sort.SortFields.Clear 'Im durch Array gefuellten Bereich von Spalte D sortieren ActiveWorkbook.Worksheets("DocNo").Sort.SortFields.Add Key:=Range("D1:D" & UBound(arrCodes) + 1), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'Sortierung anwenden With ActiveWorkbook.Worksheets("DocNo").Sort .SetRange Range("D1:D" & UBound(arrCodes) + 1) .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'String zusammensetzen iCnt = UBound(arrCodes) + 1 arrCodes = "DOC-" & Join(WorksheetFunction.Transpose(Range("D1:D" & iCnt)), "_") 'eingetragene Daten in D loeschen Range("D1:D" & iCnt) = "" 'String als Meldung ausgeben MsgBox arrCodes End Sub
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 17.02.2018
Version(en): 2016
Hi, danke, jetzt läuft es! Wenn ich jedoch nur einen Code auswähle, dann bleibt es wieder hängen. LG
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallöchen, so, jetzt ist das auch berücksichtigt. Nächster Step wäre die Prüfung auf doppelte? Code: Sub sortieren() 'Variablendeklaration 'Variant Dim arrCodes, iCnt% 'Aus Texteintrag in B1 array bilden arrCodes = Split(Cells(1, 2).Value, "_") 'Array ab D1 nach unten eintragen Range("D1").Resize(UBound(arrCodes) + 1, 1) = WorksheetFunction.Transpose(arrCodes) 'teilweise aufgezeichnet 'Sortieren zuruecksetzen ActiveWorkbook.Worksheets("DocNo").Sort.SortFields.Clear 'Im durch Array gefuellten Bereich von Spalte D sortieren ActiveWorkbook.Worksheets("DocNo").Sort.SortFields.Add Key:=Range("D1:D" & UBound(arrCodes) + 1), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'Sortierung anwenden With ActiveWorkbook.Worksheets("DocNo").Sort .SetRange Range("D1:D" & UBound(arrCodes) + 1) .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Anzahl der Array-Elemente feststellen iCnt = UBound(arrCodes) + 1 'wenn mehrere Daten enthalten sind, dann If iCnt > 1 Then 'String mit D1:Dxxx und Underline als Trennung zusammensetzen arrCodes = "DOC-" & Join(WorksheetFunction.Transpose(Range("D1:D" & iCnt)), "_") Else 'String mt D1 zusammensetzen arrCodes = "DOC-" & Range("D1") 'Ende wenn mehrere Daten enthalten sind, dann End If 'eingetragene Daten in D loeschen Range("D1:D" & iCnt) = "" 'String als Meldung ausgeben MsgBox arrCodes End Sub
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 17.02.2018
Version(en): 2016
Perfekt - es funktioniert! Vielen Dank!!!
Ja, jetzt sollte noch die Prüfung erfolgen, ob es so eine Nr. schon gibt.
LG
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallöchen, meinst Du so? Code: Sub sortieren() 'Variablendeklaration 'Variant Dim arrCodes, iCnt%, jCnt% 'Aus Texteintrag in B1 array bilden arrCodes = Split(Cells(1, 2).Value, "_") 'Array ab D1 nach unten eintragen Range("D1").Resize(UBound(arrCodes) + 1, 1) = WorksheetFunction.Transpose(arrCodes) 'teilweise aufgezeichnet 'Sortieren zuruecksetzen ActiveWorkbook.Worksheets("DocNo").Sort.SortFields.Clear 'Im durch Array gefuellten Bereich von Spalte D sortieren ActiveWorkbook.Worksheets("DocNo").Sort.SortFields.Add Key:=Range("D1:D" & UBound(arrCodes) + 1), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'Sortierung anwenden With ActiveWorkbook.Worksheets("DocNo").Sort .SetRange Range("D1:D" & UBound(arrCodes) + 1) .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Anzahl der Array-Elemente feststellen iCnt = UBound(arrCodes) + 1 arrCodes = WorksheetFunction.Transpose(Range("D1:D" & iCnt)) 'wenn mehrere Daten enthalten sind, dann If iCnt > 1 Then 'auf Mehrfachwahl pruefen 'Schleife ueber alle Elemente For jCnt = 1 To iCnt 'Wenn Inhalt der Zelle mehr als 1x vorkommt, dann If WorksheetFunction.CountIf(Range("D1:D" & iCnt), Range("D" & jCnt)) > 1 Then 'Anzahl bis Zeile jCnt hinzufuegen arrCodes(jCnt) = Range("D" & jCnt) & "-(" & Format(WorksheetFunction.CountIf(Range("D1:D" & jCnt), Range("D" & jCnt)), "00") & ")" 'Ende Wenn Inhalt der Zelle mehr als 1x vorkommt, dann End If 'Ende Schleife ueber alle Elemente Next 'String mit D1:Dxxx und Underline als Trennung zusammensetzen arrCodes = "DOC-" & Join(arrCodes, "_") ' arrCodes = "DOC-" & Join(WorksheetFunction.Transpose(Range("D1:D" & iCnt)), "_") Else 'String mt D1 zusammensetzen arrCodes = "DOC-" & Range("D1") 'Ende wenn mehrere Daten enthalten sind, dann End If 'eingetragene Daten in D loeschen Range("D1:D" & iCnt) = "" 'String als Meldung ausgeben MsgBox arrCodes End Sub
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
|