Thema Datum  Von Nutzer Rating
Antwort
Rot String trennen und in neue Zellen einfügen
12.11.2017 15:26:09 yeca
NotSolved
12.11.2017 15:44:34 Gast16126
NotSolved

Ansicht des Beitrags:
Von:
yeca
Datum:
12.11.2017 15:26:09
Views:
1626
Rating: Antwort:
  Ja
Thema:
String trennen und in neue Zellen einfügen
Hallo, ich bin neu in VBA und habe gleich mal eine Frage :) Meine Aufgabenstellung ist folgende. wir haben mehrere Excel Tabellen in welchen viele Zellen existieren, die mehrere Zeichenfolgen haben. Meine Aufgabe ist es diese großen Zellen zu löschen und die Zeichenketten in diesen Zellen in kleinere Zellen zu schreiben, d.h. dass jede Zeichenkette der großen Zelle in eine kleine (also normale Excel-Zelle) geschrieben wird. Dies möchte ich gerne mit einem Makro lösen, da es doch sehr viel Arbeit beinhaltet. D.h. ich möchte ein Makro, welches die Zeichenkette der großen Zelle liest, neue leere Zellen einfügt, und die einzelnen Zeichenketten, welche durch ein chr(10) getrennt sind, einzeln in die neuen Zellen schreibt. Ich bin so weit gekommen, dass ich die Zeichenkette trennen und auch in neue Zellen untereinander schreiben kann, jedoch überschreibt er mir die unteren Zellen. Wenn ich neue Zellen einfüge, dann fügt er mir neue Zellen zwar ein, aber nicht die getrennten Zeichenketten. D.h. das Makro macht entweder das eine oder das andere:) Könnt ihr mit bitte helfen. Hier der Quellcode: Sub trenne_Zellen() 'große Zelle trennen, Inhalt in neue, kleine Zellen schreiben 'Variablen deklarieren Dim lngZ As Long Dim strTeilstring() As String Dim strTrennzeichen As String 'Vorgaben definieren Set wsakt = ThisWorkbook.Sheets("Redaktion") 'sollte aktives Blatt sein / active.sheet lngZ = 17 'Startzeile; muss in jedem Blatt festgelegt werden // markierte Zelle bearbeiten z.B. range.selection strTrennzeichen = Chr(10) 'Trennzeichen festlegen; müsste bei uns ein Zeilenumbruch sein chr(10) 'Durchlaufen aller Datenzeilen // soll nur die aktuelle markierte Zelle bearbeiten For x = 17 To 18 'Teilstring am Zeilenumbruch auslesen strTeilstring = Split(Trim(wsakt.Cells(lngZ, 2).Value), strTrennzeichen) 'Durchlaufen des gesamten Arrays einer Zelle vom ersten bis zum letzten Wert For a = LBound(strTeilstring) To UBound(strTeilstring) 'Array-Elemente nacheinander eintragen wsakt.Cells(lngZ, 2).Value = Trim(strTeilstring(a)) ' schreibt Werte in die vorgegebene Zelle ' Ziel: Original Zelle löschen und jeden String in eine neue Zelle schreiben 'Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'ActiveSheet.Cells(x, 1).EntireRow.Insert 'ActiveSheet.Paste 'Zeilenzähler erhöhen lngZ = lngZ + 1 'neue Zeile einfügen 'ActiveSheet.Cells(17, 1).EntireRow.Insert 'fügt neue leere Zelle ein; so erst einmal richtig aber: die neue Zelle muss befüllt werden. Next a Next x End Sub Vielen Dank schon mal!

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot String trennen und in neue Zellen einfügen
12.11.2017 15:26:09 yeca
NotSolved
12.11.2017 15:44:34 Gast16126
NotSolved