Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1448to1452
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

KST aufteilen und untereinander schreiben

KST aufteilen und untereinander schreiben
22.09.2015 11:08:58
Bernd
Liebe VBA-Könner,
folgende Problemstellung habe ich:
eine Tabelle (Unterschriftenberechtigungen), in der in Spalte O die berechtigten Kostenstellen in einer Zelle stehen (getrennt durch Semikolon), sollen bitte aufgeteilt und untereinander geschrieben werden, wobei die Informationen der Spalten davor und danach auch mit übernommen werden sollen.
Beispiel mit IST und SOLL anbei. Vielen Dank vorab für Eure Lösungsvorschläge.
https://www.herber.de/bbs/user/100313.xlsx
Grüße, Bernd

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: KST aufteilen und untereinander schreiben
22.09.2015 12:43:48
Daniel
Hi
Sub test()
Dim Bereich As Range
Dim TT() As String
Dim Zelle As Range
Dim Zeile As Long
Dim Anzahl As Long
Zeile = Cells(2, "O").End(xlDown).Row
Set Bereich = Range("O3:O" & Zeile)
Zeile = Zeile + 1
For Each Zelle In Bereich
TT = Split(Zelle.Value, ";")
Anzahl = UBound(TT) + 1
Zelle.EntireRow.Copy Rows(Zeile).Resize(Anzahl)
Cells(Zeile, "O").Resize(Anzahl, 1) = WorksheetFunction.Transpose(TT)
Zeile = Zeile + Anzahl
Next
Bereich.EntireRow.Delete
End Sub
gruß Daniel

@ Daniel: Super! Tausend Dank!
22.09.2015 13:36:10
Bernd

Ergänzende Frage bitte:
22.09.2015 14:28:34
Bernd
Das Makro von Daniel läuft wunderbar.
Eine Bitte noch:
Zusätzlich soll nach der Spalte O eine Spalte eingefügt werden, dann aus der Spalte O die ersten 5 Zeichen herausgeschnitten werden und in die angefügte neue Spalte P eingefügt werden.
Bsp. wieder anbei: https://www.herber.de/bbs/user/100318.xlsm
Herzlichen Dank, Bernd

Anzeige
AW: Ergänzende Frage bitte:
22.09.2015 14:58:35
Daniel
Hi
am schluss dann noch diesen code einfügen (nach dem "Bereich.EntireRow.Delete")
    Columns("P:P").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("O:O").TextToColumns Destination:=Range("O1"), _
DataType:=xlDelimited, _
Other:=True, OtherChar:=":"
Gruß Daniel

@ Daniel: klappt wunderbar,eine kleine Frage bitte
22.09.2015 17:18:20
Bernd
Klappt wunderbar, Daniel.
Abschließende Frage bitte: kann man die Messagee "Sollen die Inhalte des Zielbereiches überschrieben werden" ausschalten, da hier (in der neuen Spalte P) an sich nichts überschrieben wird.
Grüße, Bernd

Anzeige
AW: @ Daniel: klappt wunderbar,eine kleine Frage bitte
22.09.2015 17:21:58
Daniel
vorher:
Application.DisplayAlerts um die Rückfragen des Systems zu unterbinden.
Gruß Daniel

@Daniel: Tausend Dank nochmals für Deine Hilfe.
22.09.2015 17:43:00
Bernd
Danke :-)

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige