Excel: Mehrfach Daten automatisch aus Spalte kopieren und neue Zelle erstellen?
Liebe Community,
ich bräuchte erneut eure Hilfe. :)
Aktuell lade ich täglich eine Excel Tabelle in meine Excel Vorlage hoch. Dort wird diese verarbeitet, wie z.B. sortiert usw.
Leider gibt es in der Spalte D oft mehrere Werte. Kann man diese mit VBA und Makro herausfiltern und eine neue Zeile damit befüllen? Wie ich das genau meine, siehe Screenshot.
Ich habe mir gedacht, dass man Excel hier mitteilt, dass in der Spalte D, wenn nur ein Wert mit einer Zeichenlänge von 6 Buchstaben hat, dass er dann nichts macht.
Beispiel nur Lag14 oder Lag7
Ist die Zeichenlänge länger als 6, dann soll er prüfen ob diese 15 Zeichen beträgt. Wenn ja, dann soll er den Wert zwischen 6 und 15 abschneiden und kopieren und im Anschluss in eine neue Zeile kopieren. Die anderen Spalten bleiben identisch. Eine Art Kopie sozusagen.
Beispiel für Lag/22 - Lag/51
Und dann noch das Gleiche für das Beispiel Lag/22 - Lag/51 - Lag/71
4 Antworten
Test mal dies in einem BackUp deiner Datei.
Public Sub test()
Dim AktuellLetzteZeile As Long, i As Long, j As Long
Dim ErsteDatenZeile As Long
Dim NeueZeile As Long
Dim LagerElemente
AktuellLetzteZeile = Tabelle1.UsedRange.Rows.Count 'Dies könnte deutlich unter der zuletzt beschriebenen Zeile sein. Zelle mit Farbe oder Rahmen ist auch "used"
ErsteDatenZeile = 1
NeueZeile = 1
For i = ErsteDatenZeile To AktuellLetzteZeile
LagerElemente = Strings.Split(Range("D" & i).Value, " - ", -1, vbTextCompare)
If UBound(LagerElemente) > 0 Then
Range("D" & i).Value = LagerElemente(0)
For j = 1 To UBound(LagerElemente(j))
Range("A" & AktuellLetzteZeile + NeueZeile).Value = Range("A" & i).Value
Range("B" & AktuellLetzteZeile + NeueZeile).Value = Range("B" & i).Value
Range("C" & AktuellLetzteZeile + NeueZeile).Value = Range("C" & i).Value
Range("D" & AktuellLetzteZeile + NeueZeile).Value = LagerElemente(j)
NeueZeile = NeueZeile + 1
Next j
End If
Next i
'Am Schluss ggf noch sortieren Spalte A als die Sortier GrundLage
Worksheets("Tabelle1").Sort.SortFields.Clear
Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Tabelle1").Sort
.SetRange Range("A" & ErsteDatenZeile & "D" & AktuellLetzteZeile + NeueZeile)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Achtung: Mein Blatt heißt "Tabelle7"
Aber es ist das Excel Object Tabelle19
Dies muss auf deinen Fall angepasst werden.
Diese Zeile
For j = 1 To UBound(LagerElemente(j)) 'Falsch
For j = 1 To UBound(LagerElemente) 'Richtig.
Ich hatte nur aus dem Kopf geschrieben ohne test. :-(
=== Hier nun getesteter Code:
Public Sub test()
Dim AktuellLetzteZeile As Long, i As Long, j As Long
Dim ErsteDatenZeile As Long
Dim NeueZeile As Long
Dim LagerElemente
AktuellLetzteZeile = Tabelle19.UsedRange.Rows.Count 'Dies könnte deutlich unter der zuletzt beschriebenen Zeile sein. Zelle mit Farbe oder Rahmen ist auch "used"
ErsteDatenZeile = 1
NeueZeile = 1
For i = ErsteDatenZeile To AktuellLetzteZeile
LagerElemente = Strings.Split(Tabelle19.Range("D" & i).Value, " - ", -1, vbTextCompare)
If UBound(LagerElemente) > 0 Then
Tabelle19.Range("D" & i).Value = LagerElemente(0)
For j = 1 To UBound(LagerElemente)
Tabelle19.Range("A" & AktuellLetzteZeile + NeueZeile).Value = Tabelle19.Range("A" & i).Value
Tabelle19.Range("B" & AktuellLetzteZeile + NeueZeile).Value = Tabelle19.Range("B" & i).Value
Tabelle19.Range("C" & AktuellLetzteZeile + NeueZeile).Value = Tabelle19.Range("C" & i).Value
Tabelle19.Range("D" & AktuellLetzteZeile + NeueZeile).Value = LagerElemente(j)
NeueZeile = NeueZeile + 1
Next j
End If
Next i
'Am Schluss ggf noch sortieren Spalte A als die Sortier GrundLage
Worksheets("Tabelle7").Sort.SortFields.Clear
Worksheets("Tabelle7").Sort.SortFields.Add Key:=Tabelle19.Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Tabelle7").Sort
.SetRange Tabelle19.Range("A" & ErsteDatenZeile & ":D" & AktuellLetzteZeile + NeueZeile)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
@IchMalWiederXY: Hey, ich habe das Tabellenblatt als Tabelle7 benannt und im VBA Modus heißt die Tabelle19. Dennoch funktioniert dein Code leider nicht.
Er hängt sich an dieser Stelle auf:
Worksheets("Tabelle7").Sort.SortFields.Add Key:=Tabelle19.Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
Sind die Daten bei dir in einer Tabelle oder stehen diese nur frei in den Zeilen?
Die letzten Befehle sind Sortierungsbefehle. Du möchtest das alles nach Spalte A sortiert werden soll richtig? Ich brauche aber keine Sortierung, die erfolgt später durch andere Makros.
Hey, also es funktioniert so weit alles. Danke nochmal für deine Hilfe.
- Nun habe ich aber zwei weitere Problemchen. Wenn ich das Makro anwende und die Daten befinden sich in einer dynamischen Tabelle auf dem Datenblatt, dann führt er zwar das Makro aus, aber die neuen Einträge werden nicht unten als neue Zeile eingefügt, sondern verschwinden quasi.
Sind die Daten nur in Spalte A bis D auf dem Datenblatt, funktioniert es wunderbar.
- Ich bräuchte das die ersten 3 Buchstaben aus Spalte D in Spalte F erscheinen. Also wenn in Spalte D Lag/11 steht, soll daneben nur Lag stehen.
Und nein, ein Makro mit Spalte F auswählen und überall Lag reinschreiben, ist nicht die Lösung, sonst hätte ich das schon so gemacht :P
"dynamischen Tabelle" Das heißt, die bisherigen Daten sind als "Tabelle" definiert und man müsste eigentlich mit diesen neuen Zeilen die dynamische Tabelle erweitern. mmhh.
Da bin ich eher ein Freund von Dynamischen Pivot.
Die RohDaten stehen auf einem Blatt die PIVOT Tabelle auf einem zweiten.
Immer wenn sich die RohDaten ändern wird die Refernz der Pivot Tabelle auf die neuen Ausmaße dieser Daten aufgebohrt. ..und man automatisch alle Pivot Funktionen. Scheint mir für deine Daten auch hilfreich.
===
Ggf mal den Makro Aufzeichner verwenden, was dieser für einen Code erstellt wenn in der Dynamischen Tabelle von Hand ein weiteres Element hinzukommt.
Diesen Code dann in das bisherige Makro einbauen.
@IchMalWiederXY: Hey, leider hat das nicht geklappt. Könntest Du dir das mal anschauen und den oberen VBA Code ändern, sodass er auch in einer Tabelle greift? Das wäre ganz lieb! Danke :)
Also..nochmal:
Bild Oben ist vorher: Bild unten NACH dem Makro:
ALLES was man benötigt ist im Makro bereits vorhanden gewesen.
Es ist nur eine kleine Anpassung nötig gewesen.
Du solltest auch den Code verstehen, damit dein Excel File (und die Lösung darin) überleben kann
Public Sub Test()
Dim AktuellLetzteZeile As Long, i As Long, j As Long
Dim ErsteDatenZeile As Long
Dim NeueZeile As Long
Dim LagerElemente
Dim LagerElemente2
AktuellLetzteZeile = Tabelle19.UsedRange.Rows.Count 'Dies könnte deutlich unter der zuletzt beschriebenen Zeile sein. Zelle mit Farbe oder Rahmen ist auch "used"
ErsteDatenZeile = 2
NeueZeile = 1
For i = ErsteDatenZeile To AktuellLetzteZeile
LagerElemente = Strings.Split(Tabelle19.Range("D" & i).Value, " - ", -1, vbTextCompare)
If UBound(LagerElemente) > 0 Then
Tabelle19.Range("D" & i).Value = LagerElemente(0)
For j = 0 To UBound(LagerElemente)
LagerElemente2 = Strings.Split(LagerElemente(j), "/", -1, vbTextCompare)
If j = 0 Then
Tabelle19.Range("E" & i).Value = LagerElemente2(0)
Else
Tabelle19.Range("A" & AktuellLetzteZeile + NeueZeile).Value = Tabelle19.Range("A" & i).Value
Tabelle19.Range("B" & AktuellLetzteZeile + NeueZeile).Value = Tabelle19.Range("B" & i).Value
Tabelle19.Range("C" & AktuellLetzteZeile + NeueZeile).Value = Tabelle19.Range("C" & i).Value
Tabelle19.Range("D" & AktuellLetzteZeile + NeueZeile).Value = LagerElemente(j)
Tabelle19.Range("E" & AktuellLetzteZeile + NeueZeile).Value = LagerElemente2(0)
NeueZeile = NeueZeile + 1
End If
Next j
Else
Tabelle19.Range("E" & i).Value = Tabelle19.Range("D" & i).Value
End If
Next i
End Sub
..jetzt also doch die Information Rechts des / beibehalten.
Mir scheint das andere Bildchen zeigt dies anders.
..aber, dies ist ein wirklich 'leichte' Anpassung des bisherigen Code. Versuch mal. Es muss die Stelle geändert werden, wo auf die Spalte "E" geschrieben wird.
@IchMalWiederXY: Hallo, also dein Makro funktioniert schon richtig. Du hast es vielleicht falsch verstanden oder ich blicke hier nicht mehr durch. ^^
Ich habe auch die Ursache für das Problem gefunden.
In der Spalte D habe ich ja verschiedene Werte. Beispiel nur 999/12 zu stehen oder auch mal zwei Werte 999/12 - 999/14 oder auch mal drei Werte 999/12 - 999/14 - 999/16
Dein Makro splittet diese Werte, sofern zwei, drei oder mehr vorhanden sind und erstellt eine neue Zeile mit den entsprechenden Kopien aus Spalte A, B, C usw. Soweit alles richtig.
Nun war ja mein zweites Anliegen, dass er aus Spalte D z.B bei 999/12 in Spalte E nicht auch 999/12 schreibt, sondern nur 999. Immer die ersten 3 Zeichen, die auch in Spalte D vorhanden sind. Auch das klappt alles.
Aber jetzt zum Problemchen ....
Durch Auslösen des Makros erstellt Excel entsprechend neue Zeilen, weil es Werte gibt in der Spalte D, die zwei oder mehr entsprechend. Er geht aber auch die vorhandenen Werte in Spalte D durch.
Dort wo Excel nicht eingreifen musste, weil es nur einen Wert gab, macht er folgendes, obwohl er nichts machen sollte/müsste.
Vor dem Auslösen des Makro:
Spalte D
999/12
999/14 - 888/15 - 777/17
999/22
Spalte E
999
999
999
Nachdem Auslösen des Makro:
Spalte D
999/12
999/14
888/15
777/17
Spalte E
999/12
999
888
777
Bei bereits vorhandenen Werten fügt er den /12 Kürzel hinzu, statt es zu lassen, weil es vorher schon nicht da war und auch nicht in Spalte E rein soll.
Ich habe das nun so gelöst. Es wäre eine Lösung, aber vielleicht kann man dein Makro nochmal anpassen, dann hätte ich nur ein Makro und müsste nicht das zweite hier noch benutzen. :)
For Each zelle In Range("E2:E" & Cells(Rows.Count, 5).End(xlUp).Row)
zelle = Left(Trim(zelle), 3)
Next
Diese Zeile findet heraus ob es "ein" abc/d
oder mehrere dfg/z - src/w - ...gibt.
Sobald es '0' ist, also KEIN ' - ' vorhanden, landet man im else Zweig.
Dort entsprechend anpassen.
Deinen Code benötigst du dann nicht.
Warum du "Trim" verwendest weiß ich nicht in diesem Zusammenhang. Dies entfernt diverse Zeichen VOR und NACH einem String.
Vielen Dank.
Es war die Zeile: Tabelle6.Range("F" & i).Value = Tabelle6.Range("F" & i).Value
Du hast mir sehr geholfen. Vielen Dank nochmal :P
@IchMalWiederXY: Hey, bitte nicht sauer sein...
Dein Makro hat nun funktioniert. Allerdings taucht jetzt das Problemchen auf, dass er in der Spalte E die Datensätze davor löscht und die Daten aus Spalte D dort reinkopiert.
Spalte D Spalte E
999/22 999/22 sollte aber "999" sein.
Die neuen Datensätze, die durch das Makro generiert werden, sind korrekt. Es handelt sich nur um die vorhandenen Datensätze.
mmhh,
Bei mir funktioniert dies auch mit "einer definierten Tabelle".
Die Zeilen werden direkt hinter die Tabelle geschrieben und dann wurde nach ausführen des Makros die Tabelle erweitert.
Prüfe mal welche Zeile an dieser Stelle angezeigt wird.
AktuellLetzteZeile = Tabelle19.UsedRange.Rows.Count
Wenn du NACH deiner Tabelle weiter 'unten' Format Verschmutzungen hast,
dann sind ggf die neuen Zeilen weit weit unten und ggf daher Schuld, dass es nicht wie gewünscht funktioniert.
Also, DIREKT UNTER deiner Tabelle einmal ALLE ZEILEN BIS runter zur letzten Zeile einmalig komplett löschen.
Hey, du hattest vollkommen recht. Es gab Verschmutzungen auf Höhe der Zeile 111232. Und da ich ab 400 ausgeblendet habe, konnte ich das natürlich nicht mehr sehen. Aber ärgert mich trotzdem, dass ich darauf nicht selbst gekommen bin.
Vielen lieben Dank, dass Du dir trotzdem die Mühe gemacht hast. :o)
Heyho. Dürfte ich dich noch um eine Veränderung im Code bitten?
Wenn in Spalte C folgendes steht:
111/22 - 123/44 - 166/66
177/13
188/15
199/55 - 199/66 - 199/67
usw.
Dann steht in Spalte D immer folgendes:
111
177
188
199
Also immer die reine Zahl am Anfang.
Wenn ich nun dank dir das Makro ausführe um die Zellen zu spalten, sofern natürlich was zu spalten vorhanden ist, dann macht er folgendes. Beispiel Anhand der 1 Zeile:
Spalte C
111/22
123/44
166/66
Spalte D
111
111
111
Bei Spalte D soll er aber nicht nur kopieren was noch vor der Trennung/Spaltung drin stand, sondern ich bräuchte in Spalte D immer den reinen Wert aus Spalte C, also ohne /14 oder /33
Wenn die Zelle so aussieht, dann passt es zufälligerweise mit der Spalte D, weil alle 3 Werte zufälligerweise mit den gleichen Werten anfingen:
Spalte C
199/55
199/66
199/67
Spalte D
199
199
199
Also, der folgende Code trennt zunächst:
a/b - c/d - e/f
in
a/b
c/d
e/f
um dann anschließend
a/b in
a
b zu trennen.
Dann wird IMMER das was LINKS von "/" stand in Spalte "D" geschrieben.
Siehe der neue Split:
LagerElemente2 = Strings.Split(LagerElemente(j), "/", -1, vbTextCompare)
und
Tabelle19.Range("D" & AktuellLetzteZeile + NeueZeile).Value = LagerElemente2(0)
in der Schleife
..Ich mache dies beruflich. Vielleicht will dein Chef für die gesparte Zeit etwas ausgeben ;-)
=====================================
Public Sub Test()
Dim AktuellLetzteZeile As Long, i As Long, j As Long
Dim ErsteDatenZeile As Long
Dim NeueZeile As Long
Dim LagerElemente
Dim LagerElemente2
AktuellLetzteZeile = Tabelle19.UsedRange.Rows.Count 'Dies könnte deutlich unter der zuletzt beschriebenen Zeile sein. Zelle mit Farbe oder Rahmen ist auch "used"
ErsteDatenZeile = 2
NeueZeile = 1
For i = ErsteDatenZeile To AktuellLetzteZeile
LagerElemente = Strings.Split(Tabelle19.Range("D" & i).Value, " - ", -1, vbTextCompare)
If UBound(LagerElemente) > 0 Then
Tabelle19.Range("D" & i).Value = LagerElemente(0)
For j = 1 To UBound(LagerElemente)
LagerElemente2 = Strings.Split(LagerElemente(j), "/", -1, vbTextCompare)
Tabelle19.Range("A" & AktuellLetzteZeile + NeueZeile).Value = Tabelle19.Range("A" & i).Value
Tabelle19.Range("B" & AktuellLetzteZeile + NeueZeile).Value = Tabelle19.Range("B" & i).Value
Tabelle19.Range("C" & AktuellLetzteZeile + NeueZeile).Value = Tabelle19.Range("C" & i).Value
Tabelle19.Range("D" & AktuellLetzteZeile + NeueZeile).Value = LagerElemente2(0)
NeueZeile = NeueZeile + 1
Next j
End If
Next i
End Sub
Hey, tut mir leid, aber es lag wohl eher an meiner schlechten Erklärung. Dein Marko funktioniert, jedoch leider nicht, wie ich es bräuchte. Könntest Du nochmal nach schauen. Ich habe jetzt einen Screenshot gemacht, wie ich es eigentlich meinte. Die Erklärung von vorhin musste ich von unterwegs schreiben. Sorry dafür!
"Ich mache dies beruflich. Vielleicht will dein Chef für die gesparte Zeit etwas ausgeben ;-) "
Was magst Du mir damit sagen? :P
Du könntest z.B. folgendes machen, wenn Dir die folgenden Lagerplätze unwichtig sind.
1.
2.
Ergebnis (Zeile 1)
Nun, Du könntest die verschiedenen Lager durch
- Daten - Text in Spalten - getrennt (Leerzeichen)
- auflösen. und die einzelnen Nummern nutzen
@GutenTag2003: Kannst Du mir mal ein Screenshot machen, wo ich das finde bzw. welche Funktion Du genau meinst? Danke
@GutenTag2003: Okay danke, aber ich wüsste jetzt nicht, wie ich die Werte dann in meine ursprüngliche Tabelle bekomme.
- Excel soll ja die Spalte D durch ein Makro automatisch durchsuchen.
- Wenn er zwei oder drei Werte in einer Zelle findet, dann soll er diese separieren.
- Dann jedoch nicht nebeneinander, sondern untereinander. Es soll eine neue Zelle erstellt werden.
- Die anderen Daten, wie Datum, Zentral usw. sollen übernommen werden.
@GutenTag2003: Ich habe nun den Assistenten mal ausprobiert. Klappt eigentlich ganz gut. Nur jetzt hab ich die beiden Werte jeweils in Spalte E und F.
Ich bräuchte jetzt ein Makro, dass jeweils Spalte E und F durchsucht und wenn er keine leere Zelle findet, dann soll er eine neue Zelle darunter erstellen und den gefunden Wert in Spalte D kopieren. Dann noch die Werte aus der oberen Zelle aus Spalte A, B und C. Danach soll er weiter die Spalte E und F durchsuchen.
Per VBA ist das sicher machbar.
Mit Excel würde ich mir eine Lösung kreieren, die einem VBA-Programmierer sicherlich die Hände über den Kopf zusammenschlagen ließe.
Hey, ich brauch die anderen Angaben aber auch. Siehe Screenshot mit gelb markierten stellen.
@IchMalWiederXY Der Retter in der Not. :)
Also, es funktioniert schon in die richtige Richtung. Er durchsucht die Spalte D und entfernt auch die anderen Daten in der Zelle.
Beispiel wenn Lag/1 - Lag/2 - Lag/3 steht, dann entfernt er alles, bis auf Lag/1
Aber ....
Leider löscht er den Rest nur und fügt diesen nirgendwo in eine neue Zeile. Auch kommt bedauerlicherweise beim Ausführen des Makros immer ein Fehler.
Er hängt sich in der Zeile auf:
For j = 1 To UBound(LagerElemente(j))
Funktioniert es bei dir?