Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Automatisches Kopieren variabler Datenbereiche auf ein neues Blatt





Frage

Hallo Forumsgemeinde, mein „Hobby“ ist es, Videos von bewegten Objekten aufzunehmen und die Bewegungen dann unter verschiedenen Aspekten auszuwerten. Die ‚Videos’ haben insgesamt 41 Frames und enthalten 85 für mich interessante, bewegliche Objekte. Eine spezielle Software erstellt mir bei der Auswertung des Films eine Tabelle, in der für jedes Objekt die XY-Koordinaten für die einzelnen Frames aufgelistet sind. Das ergibt eine Tabelle mit maximal 3486 Zeilen (incl. Überschrift). Maximal, da manchmal einzelne Objekte aus dem Bildbereich verschwinden, oder nicht von Anfang an sichtbar waren. In der Praxis sind es eher ~2800 +/- 300 Zeilen. Die Daten stehen zusammenhängend bündig untereinander, Leerzeilen gibt es innerhalb der Tabelle nicht. Spalte A enthält eine laufende Nummer (1- max. 3485) Spalte B die Probennummer (1-85; z.B. 41 Zeilen lang die [i]1[/i], 36 Zeilen lang die [i]2[/i], 40 Zeilen mit der [i]3[/i], usw….) Spalte C enthält die Frame-Nummer des Videos Spalte D eine X-Koordinate Spalte E eine Y-Koordinate. Zur weiteren Verarbeitung muss ich die Daten in das folgende Format bringen: Spalte A; Zeilen 1-41: X-Koordinaten für Probe 1 Spalte B; Zeilen 1-41: Y-Koordinaten für Probe 1 Spalte C; Zeilen 1-41: X-Koordinaten für Probe 2 Spalte D; Zeilen 1-41: Y-Koordinaten für Probe 2 Spalte E; Zeilen 1-41: X-Koordinaten für Probe 3 und so weiter bis Spalte ´FN´ mit den Y-Koordinaten von Probe 85. So ergibt sich also bei 85 Probennummern mit jeweils (max.) 41 XY-Koordinaten eine neue Tabelle mit 170 Spalten und (max.) 41 Zeilen. Die Koordinaten müssen bei Proben mit <41 XY-Koordinaten oben bündig eingetragen werden. Meine bisherige Lösung des Problems ist eine eher unelegante Variante, bestehend aus einem Batt, in dem rund 600.000 Zellen eine Wenn-Funktion ausführen. Anschließend werden die Nullen entfernt und die Zahlen nach oben verschoben. Die Datei ist daher aber denkbar unhandlich… Vielen Dank schonmal und viele Grüße, iridium

Antwort 1 von iridium

Nachtrag:

Die XY-Koordinaten erreichen niemals den Wert 0, sondern immer zwischen1 und 512.

In dem neuen Tabellenblatt sollen am Ende nur die Koordinaten stehen, weder laufende Nummer noch Probennummer. Die Identität der Koordinaten ergibt sich für mich dann ausschließlich aus ihrer Position

Ich könnte mir eine Lösung vorstellen, die Zeilen weise die Probennummer der Koordinaten überprüft und abhängig von dieser in bestimmt Spalten eines neuen Blattes transponiert. Wenn die Probennummer in den Ursprungsdaten zum zweiten, dritten, ect. mal gefunden wird, müsste das Script die Koordinaten immer in die nächste freie Zeile schreiben.

viele grüße,
iridium

Antwort 2 von schnallgonz

Hi iridium,
was es alles gibt...
Also, ich meinte, Dein Problem verstanden zu haben, schau mal meine letzte Antwort in Deinem ersten Posting.
Was ich jetzt nicht verstehe, was Du mit den tausenden von wenns abfragst und wo die Nullen herkommen, wenn die Koordinaten nie = 0 sind.

Sortiere doch einfach aufsteigend nach SpalteB und als 2.Kriterium nach SpalteA.
Dann hast Du alle ProbenNr im Block und mußt diese Blöcke nacheinander in die entsprechenden Spalten kopieren, also
ProbenNr1 mit z.B. 35 Zeilen nach Spalten A und B
ProbenNr2 mit z.B. 41 Zeilen nach Spalten C und D usw.

Das sollte per makro möglich sein. Gut, wenn dazu noch der Aufbau der ProbenNr bekannt wäre.

Ich gehe jetzt schlafen, wenn meine Darstellung stimmt, melde das bitte oder korrigiere es, vielleicht schreibt noch jemand ein script, der noch nicht müde ist oder morgen mehr Zeit hat als ich.

gruß
schnallgonz

Antwort 3 von iridium

@schnallgonz

Zitat:
Sortiere doch einfach aufsteigend nach SpalteB und als 2.Kriterium nach SpalteA.
Dann hast Du alle ProbenNr im Block und mußt diese Blöcke nacheinander in die entsprechenden Spalten kopieren, also
ProbenNr1 mit z.B. 35 Zeilen nach Spalten A und B
ProbenNr2 mit z.B. 41 Zeilen nach Spalten C und D usw.


Genau das will ich ja! Die Proben sind ja sogar schon sortiert - im Block -, nur mit dem Transponieren fehlt mir das Wissen, um das mit einem Script zu erledigen.

Vom Script müssen Zeilenweise in der Spalte B (nicht anderswo, denn Werte 1-85 können auch als Koordinaten vorkommen) die Probennummern gesucht und die entsprechenden Koordinaten (Spalten D und E) daneben in die jeweiligen Spalten eines neuen Blattes kopiert werden, hier dann jeweils immer in die nächste freie Zeile.

Zitat:
Gut, wenn dazu noch der Aufbau der ProbenNr bekannt wäre.


Die Probennummer ist eine einfache Zahl von 1-85 in der Spalte B.

Wem das jetzt zu lang wird, bitte den Rest des Postings überlesen, da nicht zum Veständnis der Frage nötig!!

Zitat:
Was ich jetzt nicht verstehe, was Du mit den tausenden von wenns abfragst und wo die Nullen herkommen, wenn die Koordinaten nie = 0 sind.[/quote

Ich habe, um das Transponieren ohne Makro zu erledigen, eine Tabelle erstellt, die 170 Spalten x 3585 Zeilen gross ist. In Spalte A beispielsweise wird in jeder Zeile mit einer Wenn Funktion geprüft, ob in dem Blatt mit den Daten in der gleichen Zeile die Probennummer = 1 ist, Wenn ja wird der X-Wert aus der gleichen Zeile eingesetzt, wenn nein, dann eine 0. In der Spalte B das selbe Spiel, nur wird ggf. der Y-Wert eingefügt. So habe ich dann praktisch eine riesige Tabelle und darin - zwischen hunderttausenden Nullen eine Diagonale von oben links nach unten rechts mit meinen Daten. Dann Nullen löschen, Daten nach oben schieben - fertig. Leider seeeehr speicher- und rechenintensiv. Nicht so die elegante Lösung. Eher der Holzhammer.

Viele Grüße und danke für deine Geduld,
iridium

Antwort 4 von coros

Hallo iridium,

so langsam fange auch ich an zu verstehen, was Du erreichen möchtest. Die kleinen offenen Fragen sollten sich durch eine Beispieldatei beantworten lassen. Da ich keine Lust habe, mir eine Datei anzufertigen, die Deiner ähnlich ist, stelle doch bitte, wie ja auch bereits von Gert in Deinem alten Posting angeregt, die Datei mal z.B. bei http://www.netupload.de/ ins Internet und poste den Link zur Datei dann hier. Dann kann man sich das ansehen und dann werden sich sicherlich die letzten offenen Fragen in Luft auflösen und dann wird es auch sicherlich eine Lösung geben.

Noch ein Hinweis: Vermeide es zu ein und der gleichen Frage mehrere Beiträge zu erstellen. Auch wenn Du der Meinung gewesen bist, dass der Alte zu unübersichtlich wird, wäre es sinnvoller gewesen in dem alten Beitrag weiter zu machen. Jemand der zu Deinen alten Beitrag durch die Forensuche gelangt, kann den weiteren Verlauf und eine eventuelle Lösung nicht nachvollziehen, da der Beitrag endet und ein Neuer aufgemacht wurde, der Suchende aber nicht weiß, wie der neue Beitrag lautet. Also bleibe nächstes Mal wegen einer Frage in einem Beitrag. Ist für alle die nach Dir den Beitrag lesen, übersichtlicher, weil dort dann auch eine eventuelle Lösung vorhanden ist, auch wenn er für Dich unübersichtlich zu sein scheint. Außerdem wird es Dir der Supportnetserver danken.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 5 von iridium

Eine Datei mit ´echten´ Daten ist bei Netupload unter

http://www.netupload.de/detail.php?img=77b60d550549b67b68cb420af21f8bba.xls

@Oliver

Sorry nochmal wegen des neuen Threads. Hab es nur gut gemeint. Aber der Link im alten ist natürlich eine gute Idee.

Viele Grüße,
Iridium

Antwort 6 von coros

Hallo iridium,

na bitte, eine Beispieldatei sagt mehr als 19 Beiträge (Summe aus Deinem ersten und dem jetzigen Beitrag). Ich schätze mal ohne die Beispieldatei wäre dieser Thread um ein vielfaches länger geworden. Nachfolgend das Makro, welches Dir Deine Koordinatendaten in das 2. Tabellenblatt nebeneinander aufführen sollte. Bitte kopiere das Makro in ein "StandardModul" und starte es z.B. über eine Befehlsschaltfläche.

Option Explicit

Sub Daten_kopieren()
Dim i As Integer, j As Integer
Dim Anfang As Integer, Ende As Integer
Dim Spalte As Integer
Rem:Bildschirmaktualisierung ausschalten
Rem: Verhindert das jeder Einzellschritt am Bildschirm angezeigt wird
Application.ScreenUpdating = False
Rem: Alle Einträge in Blatt 2 löschen
Sheets(2).Cells.ClearContents
Rem: Startwerte festlegen
Ende = 3
Anfang = 2
Spalte = 1
Rem: Zur Sprungmmarke "Nächste" wechseln
GoTo Nächste
Rem: Sprungmarke "Start" festlegen
Start:
Rem: Schleife zum Finden des Starts der nächsten Sample No.
For i = Ende To Range("B65536").End(xlUp).Row
Rem: Wenn Sample No wechselt, die Zeilennummer in Variable
Rem: Anfang schreiben und Schleife verlassen
If Cells(i, 2) <> Cells(i - 1, 2) Then
Anfang = i
Exit For
End If
Next
Rem: Sprungmarke "Nächste" festlegen
Nächste:
Rem: Schleife zum Finden des Endes der nächsten Sample No.
For j = Anfang To Range("B65536").End(xlUp).Row
Rem: Wenn Sample No wechselt, die Zeilennummer in Variable
Rem: Ende schreiben und Schleife verlassen
If Cells(j, 2) <> Cells(j + 1, 2) Then
Ende = j
Exit For
End If
Next
Rem: Den Bereich der ermittelten Sample No aus Spalte D & E kopieren
Rem: und in Blatt 2 in die Spalte mit der Spaltenindexnummer aus Variable
Rem: "Spalte" einfügen
Range(Cells(Anfang, 4), Cells(Ende, 5)).Copy
Sheets(2).Cells(1, Spalte).PasteSpecial
´Rem: Variable "Spalte" um den Wert 1 erhöhen
Spalte = Spalte + 2
Rem: Wenn Variable "Ende" die Zeilennummer der letzten ausgefüllten Zeile
´Rem: aufweist, Prozedur beenden
If Ende = Range("B65536").End(xlUp).Row Then Exit Sub
Rem: Zur Sprungmmarke "Start" wechseln
GoTo Start
End Sub


Bei dem Makro werden immer die Daten, aus Spalte D und E, die zu einer Sample No. gehören, in das 2. Tabellenblatt nebeneinander kopiert.

Ich hoffe, Du meintest das so. Bei Fragen melde Dich bitte.

Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 7 von iridium

Hallo Oliver,

super, klasse, ich bin begeistert !!!! Minimale Dateigröße und super-flott! Mein nächster Buchkauf wird ein VBA Einsteiger-Buch ;-). Herzlichen Dank!

Eine Frage nur noch abschließend:
Was müsste ich an den letzten Zeilen Deines Codes verändern, damit ich noch ein paar einfache Befehle einbauen kann, die da wären:

Sheets(1).Select
Range("A2:I4000").Select
Selection.ClearContents
Range("A2").Select

Sheets(2).Select
Rows("22:23").Select
Selection.Insert Shift:=xlDown
Rows("21:21").Select
Selection.Copy
Rows("23:23").Select
ActiveSheet.Paste

Range("A1:IT21").Select
Range("A1").Activate
Selection.Copy

Dann erst endgültig das ´End Sub´

MfG,
Iridium

Antwort 8 von coros

Hallo iridium,

Nachfrage, Du willst die Daten in Sheet 1 löschen, das ist klar, aber in Sheet 2, soll dort zwischen den Zeilen 21 und 23 eine Leerzeile entstehen oder ist das ein versehen? Eventuell kannst Du mal kurz erklären was Du erreichen möchtest.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 9 von iridium

Hallo Oliver,

Die Leerzeile ist gewollt (zur optischen Orientierung für mich), auch das Kopieren der Daten aus Zeile 21 nach Zeile 23. Anschließend wird alles Markiert und ins Clipboard kopiert - fertig zum Einfügen in eine Tabelle zur umfassenden Auswertung der Daten. Diese kann aber leider z.Zt. nur mit max. 21 Zeilen gefüttert werden.

Die untere Hälfte der Daten kann ich dann später nochmal in diese Tabelle einlesen und die Ergebnisse ggf. innerhalb der Daten mitteln. Wird aber nur durchgeführt, wenn ausreichend Proben im Datensatz waren, die deutlich über 21 Koordinatenpaare geliefert haben.

Leider fehlt mir (noch) das Know-how, diese Befehle an Deinen Code hinten dran zu hängen...

Grüße
Iridium

Antwort 10 von coros

Hallo iridium.

nachfolgender Code sollte das machen, was Du Dir vorgestellt hast.

Option Explicit

Sub Daten_kopieren()
Dim i As Integer, j As Integer
Dim Anfang As Integer, Ende As Integer
Dim Spalte As Integer
Rem:Bildschirmaktualisierung ausschalten
Rem: Verhindert das jeder Einzellschritt am Bildschirm angezeigt wird
Application.ScreenUpdating = False
Rem: Alle Einträge in Blatt 2 löschen
Sheets(2).Cells.ClearContents
Rem: Startwerte festlegen
Ende = 3
Anfang = 2
Spalte = 1
Rem: Zur Sprungmmarke "Nächste" wechseln
GoTo Nächste
Rem: Sprungmarke "Start" festlegen
Start:
Rem: Schleife zum Finden des Starts der nächsten Sample No.
For i = Ende To Range("B65536").End(xlUp).Row
Rem: Wenn Sample No wechselt, die Zeilennummer in Variable
Rem: Anfang schreiben und Schleife verlassen
If Cells(i, 2) <> Cells(i - 1, 2) Then
Anfang = i
Exit For
End If
Next
Rem: Sprungmarke "Nächste" festlegen
Nächste:
Rem: Schleife zum Finden des Endes der nächsten Sample No.
For j = Anfang To Range("B65536").End(xlUp).Row
Rem: Wenn Sample No wechselt, die Zeilennummer in Variable
Rem: Ende schreiben und Schleife verlassen
If Cells(j, 2) <> Cells(j + 1, 2) Then
Ende = j
Exit For
End If
Next
Rem: Den Bereich der ermittelten Sample No aus Spalte D & E kopieren
Rem: und in Blatt 2 in die Spalte mit der Spaltenindexnummer aus Variable
Rem: "Spalte" einfügen
Range(Cells(Anfang, 4), Cells(Ende, 5)).Copy
Sheets(2).Cells(1, Spalte).PasteSpecial
´Rem: Variable "Spalte" um den Wert 1 erhöhen
Spalte = Spalte + 2
Rem: Wenn Variable "Ende" die Zeilennummer der letzten ausgefüllten Zeile
´Rem: aufweist, zur Sprungmarke "Ende" springen
If Ende = Range("B65536").End(xlUp).Row Then GoTo Ende
Rem: Zur Sprungmmarke "Start" wechseln
GoTo Start
Rem: Sprungmarke "Ende" festlegen
Ende:
Rem: Inhalte im Bereich A2:I4000 entfernen
Range("A2:I4000").ClearContents
Rem: In Tabellenblatt 2 zwei Leerzeile zwischen Zeile 22 und 23 einfügen,
Rem: Zeile 21 kopieren und in Zeile 23 einfügen
With Sheets(2)
.Rows("22:23").Insert Shift:=xlDown
.Rows("21:21").Copy
.Rows("23:23").PasteSpecial
End With
End Sub



MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 11 von iridium

Super, tausend Dank!

Ich denke, damit ist das Thema dann für mich erfolgreich abgeschlossen!

Viele Grüße nochmals, Iridium