Tabelle neu anordnen

Forumthread: Tabelle neu anordnen

23.11.2016 18:55:07

Jenny

Hallo an alle,
bitte helft mir, hänge zur Veranschaulichung auch ein Beispiel an:
https://www.herber.de/bbs/user/109664.xlsx
Es geht mir um folgndes, habe eine Tabelle mit ca. 1500 Zeilen, die so aufgebaut ist wie in Spalte A.
Seht ihr eine Möglichkeit, diese so aufzubauen wie in den Spalten C bis E, also ohne alles einzeln von hand kopieren und einfügen zu müssen?
Danke für euren Rat
Jenny

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Tabelle neu anordnen

23.11.2016 20:18:37

Fennek
AW: Tabelle neu anordnen

23.11.2016 20:24:40

Jenny
AW: Tabelle neu anordnen

23.11.2016 20:37:46

Fennek
AW: Tabelle neu anordnen

23.11.2016 21:24:00

Jenny
AW: Tabelle neu anordnen

23.11.2016 22:13:41

Fennek
AW: Tabelle neu anordnen

23.11.2016 22:18:14

Jenny
AW: Tabelle neu anordnen

23.11.2016 22:20:55

Fennek
AW: Tabelle neu anordnen

24.11.2016 07:49:33

Jenny

AW: Tabelle neu anordnen

23.11.2016 20:18:37

Fennek

Hallo,
versuche diesen Code (sehr genau auf die Spalten des Beispiels angepasst)


Sub Jenny()
i = 1
Columns("C:E").Clear
With ActiveSheet.UsedRange.Columns(1).SpecialCells(2)
For Each Ar In .Areas
Ar.Cells(1).Copy Cells(i, 3)
Range(Ar.Cells(2), Ar.Cells(1).Offset(Ar.Count - 1)).Copy Cells(i, 4)
'Debug.Print Ar.Count
i = i + Ar.Count - 1
Next Ar
End With
Columns(4).TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
y = Columns("E").Replace(")", "")
lr = Cells(Rows.Count, 4).End(xlUp).Row
Range("C1:C" & lr).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
Range("C1:C" & lr).Copy
Cells(1, 3).PasteSpecial xlValues
End Sub

mfg

AW: Tabelle neu anordnen

23.11.2016 20:24:40

Jenny

Hallo Fennek,
vielen dank erstmal für die viele Mühe.
Das Makro ist auch fast perfekt, wäre nur noch schön, wenn es in Spalte D noch die Bindestriche am Anfang löscht.
Suchen und Ersetzen hilft mir da leider nicht weiter, da manche Leute in der Liste Doppelnamen mit Bindestrichen haben.
Aber ansonsten, super Arbeit, vielen vielen Dank.
Jenny

AW: Tabelle neu anordnen

23.11.2016 20:37:46

Fennek

Hallo,
versuche es mit
Tx = cells(1,"D")
Neu = right(Tx, len(Tx)-1)
für jede Zeile in Spalte D
mfg

AW: Tabelle neu anordnen

23.11.2016 21:24:00

Jenny

Hallo Fennek,
sorry aber ich habe nicht die geringste Ahnung an welche Stelle des Makros ich das einfügen muss.
Jenny

AW: Tabelle neu anordnen

23.11.2016 22:13:41

Fennek

Hallo,


Sub Jenny()
i = 1
Columns("C:E").Clear
With ActiveSheet.UsedRange.Columns(1).SpecialCells(2)
For Each Ar In .Areas
Ar.Cells(1).Copy Cells(i, 3)
Range(Ar.Cells(2), Ar.Cells(1).Offset(Ar.Count - 1)).Copy Cells(i, 4)
'Debug.Print Ar.Count
i = i + Ar.Count - 1
Next Ar
End With
Columns(4).TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
y = Columns("E").Replace(")", "")
lr = Cells(Rows.Count, 4).End(xlUp).Row
Range("C1:C" & lr).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
Range("C1:C" & lr).Copy
Cells(1, 3).PasteSpecial xlValues
'Nicht schön, sollte aber funktionieren (ungeprüft)
for i = 1 to lr
if left(cells(i,"D") = "-" then
cells(i, "D") = right(cells(i, "D"), len(cells(i, "D"))-1)
end if
next i
End Sub

AW: Tabelle neu anordnen

23.11.2016 22:18:14

Jenny

er meldet leider in der Zeile
if left(cells(i,"D") = "-" then
einen Syntaxfehler.
Gruß
Jenny

AW: Tabelle neu anordnen

23.11.2016 22:20:55

Fennek

Hi,
(zu) spät am abend:


if left(cells(i,"D"),1) = "-" then

AW: Tabelle neu anordnen

24.11.2016 07:49:33

Jenny

Hallo,
ja jetzt funktioniert es.
Wenn jetzt noch die Fettschrift und der Unterstrich in Spalte C rausgenommen würde, wäre es perfekt, aber das kann ich ja auch recht schnell und unkompliziert von Hand machen.
Danke für deine Mühe.
Jenny

Beliebteste Forumthreads (12 Monate)

Forumthread: Tabelle neu anordnen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread