KST aufteilen und untereinander schreiben

Bild

Betrifft: KST aufteilen und untereinander schreiben
von: Bernd
Geschrieben am: 22.09.2015 11:08:58

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

Bild

Betrifft: AW: KST aufteilen und untereinander schreiben
von: Daniel
Geschrieben am: 22.09.2015 12:43:48
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

Bild

Betrifft: @ Daniel: Super! Tausend Dank!
von: Bernd
Geschrieben am: 22.09.2015 13:36:10


Bild

Betrifft: Ergänzende Frage bitte:
von: Bernd
Geschrieben am: 22.09.2015 14:28:34
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

Bild

Betrifft: AW: Ergänzende Frage bitte:
von: Daniel
Geschrieben am: 22.09.2015 14:58:35
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

Bild

Betrifft: @ Daniel: klappt wunderbar,eine kleine Frage bitte
von: Bernd
Geschrieben am: 22.09.2015 17:18:20
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

Bild

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

Bild

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

 Bild

Beiträge aus den Excel-Beispielen zum Thema "KST aufteilen und untereinander schreiben"