Wert einer Zelle auslesen

[yven]

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!

[Werner.M]

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

[yven]

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.

[Werner.M]

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

[LCohen]

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