Hallo,
ich möchte eine Tabelle mit ca. 1500 Zeilen etwas aufräumen.
Dabei soll der Wert oder Inhalt einer Zelle in eine andere Zelle übertragen werden. Anschließend möchte ich die Urspurngszelle löschen und der Wert in der neuen Zelle soll erhalten bleiben.
Ich hoffe, ich konnte mich verständlich ausdrücken und ihr habt einen Tipp.
Danke!
Hallo,
du willst also den Inhalt von 1500 Zellen irgend wo hin kopieren und die ursprünglichen 1500 Zellen löschen. Was hast du denn dabei gewonnen in Bezug auf "Aufräumen".
Was du eigentlich willst ist "unverständlich".
Gruß Werner
Ich versuche es mal mit einem Beispiel einer Autotabelle:
Auto1 4 Türer Automatik 1,6 Liter
Caprio 5 Sitze Kofferraum 200 Liter
Klima usw.
Auto2 usw. x
x x
x
Auto3
Für jedes Fahrzeug werden derzeit 3 Zeilen benötigt.
Ich möchte die Informationen alle nebeneinander aufgeführt haben, um anschließend auch besser Filtern zu können. z.Bsp. zeige mir alle Auto's mit 200 Liter Kofferraum an.
so:
Auto1 4 Türer Automatik 1,6 Liter Caprio 5 Sitze Kofferraum 200 Liter Klima usw.
Zeitgleich wird die Tabelle um 1/4 kürzer, wenn man die Leerzeile zwischen den Auto's anschließend auch noch löscht.
Die Tabelle würde für mich übersichtlicher sein.
Hallo,
du hälst min deinen Infos aber ziemlich hinter dem Berg. Ich habe keine Ahnung in welcher Zeile und in welcher Spalte deine Daten beginnen / stehen.
Ich bin jetzt einfach mal davon ausgegangen, dass der erste Datensatz in Spalte A und Zeile 2 beginnt. Die Daten werden in ein anderes Tabellenblatt kopiert. Dein Ursprungsblatt kannst du dann ja löschen oder leeren.
Teste mal:
Code:
Option Explicit
Public Sub Test()
Dim loStartzeile As Long, loStartspalte As Long
Dim loSpalteQuelle As Long, loSpalteZiel As Long
Dim loLetzte As Long, loZielzeile As Long, loSpalte As Long
Dim raZelle As Range, raBereich As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Blattname anpassen
With Worksheets("Quelltabelle")
'Startzeile anpassen
loStartzeile = 2
'Startspalte anpassen
loStartspalte = 1
'Zielzeile anpassen
loZielzeile = 2
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
Set raBereich = .Range(.Cells(loStartzeile, loStartspalte), .Cells(loLetzte + 2, loStartspalte))
For Each raZelle In raBereich
If raZelle <> "" Then
loSpalte = .Cells(raZelle.Row, .Columns.Count).End(xlToLeft).Column
'Blattname anpassen
Worksheets("Zieltabelle").Cells(loZielzeile, 1).Resize(1, loSpalte).Value = raZelle.Resize(1, loSpalte).Value
Else
loSpalte = .Cells(raZelle.Row, .Columns.Count).End(xlToLeft).Column
If loSpalte = 1 Then
loZielzeile = loZielzeile + 1
GoTo Weiter
End If
'Blattname anpassen
With Worksheets("Zieltabelle")
loSpalteZiel = .Cells(loZielzeile, .Columns.Count).End(xlToLeft).Offset(0, 1).Column
.Cells(loZielzeile, loSpalteZiel).Resize(1, loSpalte).Value = raZelle.Offset(0, 1).Resize(1, loSpalte).Value
End With
End If
Weiter:
Next raZelle
End With
Set raBereich = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Gruß Werner
1. Cabrio, nicht Caprio. Leonardo-di hätte was dagegen.
2. Nicht um 1/4, sondern auf 1/4.
Deine Daten beginnen in A1 und gehen bis F1 (also etwas mehr, als in Deinem Beispiel mit D1). Dann:
=WENN(SPALTE(A1)=1;INDEX(A:A;ZEILE(A1)*4-3);INDEX($B:$F;ZEILE(A1)*4-4+SPALTE(E1)/5;REST(SPALTE(E1);5)+1))
Gingen sie nur bis D1, ändert sich die Formel wie folgt:
=WENN(SPALTE(A1)=1;INDEX(A:A;ZEILE(A1)*4-3);INDEX($B:$D;ZEILE(A1)*4-4+SPALTE(C1)/3;REST(SPALTE(C1);3)+1))
Bis Z1 gehend:
=WENN(SPALTE(A1)=1;INDEX(A:A;ZEILE(A1)*4-3);INDEX($B:$Z;ZEILE(A1)*4-4+SPALTE(Y1)/25;REST(SPALTE(Y1);25)+1))