Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1524to1528
1524to1528
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Tabelle neu anordnen

Forumthread: Tabelle neu anordnen

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
Anzeige

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
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
Anzeige
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

Anzeige
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige