Hallo liebe Profis,
ich habe da mal eine Frage. Wäre es möglich, das alles per Makro zu lösen?
Anbei ein Auszug der Tabelle um die es geht. Die Tabelle ist eigentlich viel länger etwa 400.000 Zeilen.
Also zum Problem:
In Spalte A steht eine Zahl und darunter mehrere Zeilen mit Zahl und Text. Jetzt sollen die Zeilen mit Zahl und Text die unter der Zahl stehen, neben der Zahl in Spalten stehen.
Ich konnte das Problem mithilfe von kopieren und transponieren "lösen", siehe Anfang der Tabelle.
Da die Tabelle aber sehr groß ist, würde das ja ewig dauern.
Gibt es eine schnellere Lösung?
Viele Grüße
Eva
Hallo Eva
du hast leider kein Bespiel von 20-30 Zeilen aus Spalte A beigefügt aus dem man erkennen kann wie das genau aufgebaut ist? Heisst das, es kommt eine echte Zahl wie 10887564, gefolgt von Zahlen mit Text, dann wieder eine echte Zahl???
mfg Gast 123
Hallo Eva
evtl nicht die Schnellste Methode...
Code:
Option Explicit
Sub Trans()
Dim LR As Long, i As Long, LastR As Long
Application.ScreenUpdating = False
With Sheets("test")
LR = .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
LastR = LR
For i = LR To 2 Step -1
If .Cells(i, 1) <> "" And .Cells(i, 2) = "" Then
If IsNumeric(.Cells(i, 1)) Then
.Range(.Cells(i + 1, 1), .Cells(LastR, 1)).Copy
.Cells(i, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
.Range(.Cells(i + 1, 1), .Cells(LastR, 1)).EntireRow.Delete
LastR = i - 1
End If
Else
LastR = LastR - 1
End If
Next
End With
End Sub
LG UweD
(18.09.2019, 14:19)Gast 123 schrieb: [ -> ]Hallo Eva
du hast leider kein Bespiel von 20-30 Zeilen aus Spalte A beigefügt aus dem man erkennen kann wie das genau aufgebaut ist? Heisst das, es kommt eine echte Zahl wie 10887564, gefolgt von Zahlen mit Text, dann wieder eine echte Zahl???
mfg Gast 123
Genau, es kommt eine echte Zahl gefolgt von Zahlen mit Text dann wieder eine echte Zahlt gefolgt von Zahlen mit Text, wobei nicht immer gleich viele Zahlen mit Text auf eine echte Zahl folgen, das kann variieren.
Hallo,
wenn die Überschrift in A1 gelöscht wird, sollte dieser Code helfen:
Code:
Sub Eva()
'Überschrift in A1 löschen
Dim Ar As Range
For Each Ar In Columns(1).SpecialCells(2, 2).Areas
Ar.Copy
Ar.Cells(1).Offset(-1, 1).PasteSpecial Transpose:=True
Ar.Clear
Next Ar
End Sub
Die Leerzeilen kann man mit Taste-F5, Inhalte, Leerzellen auf einmal und sehr schnell löschen.
mfg
Zitat:Hallo Eva
evtl nicht die Schnellste Methode...
Hallo UweD vielen Dank! Funktioniert !
LG Eva