Tracking-Analyse

[schauan]

Hallöchen,

hier ist erst mal der korrigierte Code. Die aktive Zelle hat nach dem ersten Durchlauf nicht mehr gepasst daher waren auch Daten drin, aber eben nicht alle. Übrigens werden beim Kopieren auch die Überschriften mitgenommen, die müssen bestimmt auch noch weg, oder stören die nicht?

Modul Modul1

Sub Makro1() 
'Variablendeklarationen 
'Long 
Dim lLRow&, lLCol& 
    'Mit dem aktiven Blatt 
    With ActiveSheet 
      'erst mal in Spalte B Leerzeichen entfernen 
      .Columns(2).Replace What:=" ", Replacement:="", LookAt:=xlPart 
      'erste zu kopierende Datenspalte aktivieren 
      .Cells(1, 5).Activate 
      'Solange in der aktiven Zelle Daten stehen 
      Do While ActiveCell.Value <> "" 
        'letzte belegte zelle in Spalte B feststellen (zum spaeteren Einfuegen) 
        lLRow = .Cells(Rows.Count, 2).End(xlUp).Row 
        lLCol = ActiveCell.Column 
        'eventuelle Leerzeichen entfernen - scheinbar leere Zellen haben alle eins ... 
        .Range(ActiveCell.Resize(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, 3).Address).Replace What:=" ", Replacement:="", LookAt:=xlPart 
        'filter setzen 
        .Cells(1, 1).AutoFilter 
        'leere Zellen anhand erster Spalte im Datenbereich ausfiltern 
        .Range(Cells(1, 1).Resize(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, ActiveCell.Column).Address).AutoFilter Field:=ActiveCell.Column, Criteria1:="<>" 
        'sicherheitshalber nachschauen, ob was zu tun ist - anhand nicht leerer Zellen 
        If WorksheetFunction.Subtotal(103, .Range(ActiveCell.Resize(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, 3).Address)) > 3 Then 
          'sichtbare Zellen im Datenbereich kopieren 
          .Range(ActiveCell.Resize(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, 3).Address).SpecialCells(xlVisible).Copy 
          'und an Spalte B (und C und D) anhaengen 
          .Cells(lLRow + 1, 2).PasteSpecial Paste:=xlPasteValues 
        'Ende sicherheitshalber nachschauen, ob was zu tun ist - anhand nicht leerer Zellen 
        End If 
        'Autofilter zuruecksetzen 
        .Cells(1, 1).AutoFilter 
        'naechste Zelle aktivieren - 3 Spalten weiter 
        Cells(1, lLCol).Offset(0, 3).Activate 
      'Ende Solange in der aktiven Zelle Daten stehen 
      Loop 
   'Ende Mit dem aktiven Blatt 
   End With 
End Sub 

[lpterritory]

Ahh jetzt ist es nahezu perfekt, allerdings werden die Spalten jetzt noch direkt untereinander gereiht. Ich hab mal n Screenshot gemacht. Auf dem sieht man, dass da zwischen den Wertepaaren noch beispielsweise 6 Leerzeilen (können auch mal mehr oder weniger sein) sind, und die müssten dann auch bei der Untereinanderreihung auftauchen. Gibt es vielleicht auch eine Möglichkeit die Zeile mit den Überschriften direkt rauszuhauen, also das praktisch direkt die Werte der jeweiligen Spalte aufgereiht werden mit den jeweiligen Leerzeilen dazwischen oder müsste ich dafür die Datei der Messdaten vorher bearbeiten und die Überschriften rauslöschen?

Sorry, dass ich selbst da nicht so ganz hintersteige :S aber ich bin dir für die Hilfe sehr dankbar

[schauan]

Hallöchen,

da musst Du nir eine Zeile austauschen, wo kopiert wird:

Code:

'sichtbare Zellen im Datenbereich kopieren
.Range(ActiveCell.Offset(1).Resize(.UsedRange.SpecialCells(xlCellTypeLastCell).Row - 1, 3).Address).SpecialCells(xlVisible).Copy

Da ist jetzt noch der ".Offset(1)" drin und weiter hinten die "- 1" Der Offset schiebt den Bereich eine zeile nach unten und damit wäre es ja eine zuviel, deswegen dann -1.

[lpterritory]

Hallöchen,

ahh okay ja gut das habe ich verstanden, die Überschriften sind dann jetzt auch weg und die Werte direkt untereinander gefügt :)

Um jetzt aber die Leerzeilen zwischen den Werten in den Spalten zu berücksichtigen (wie man im Screenshot sieht), müsste man wahrscheinlich etwas an folgendem Part verändern oder?

Code:

'leere Zellen anhand erster Spalte im Datenbereich ausfiltern
.Range(Cells(1, 1).Resize(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, ActiveCell.Column).Address).AutoFilter Field:=ActiveCell.Column, Criteria1:="<>"
'sicherheitshalber nachschauen, ob was zu tun ist - anhand nicht leerer Zellen
If WorksheetFunction.Subtotal(103, .Range(ActiveCell.Resize(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, 3).Address)) > 3 Then

[schauan]

Hallöchen,
Der Punkt ist, dass ich jetzt alle Leerzellen wegfilter. Sollen denn alle Leerzeilen mitgenommen werden, also dann ab Zeile 2 bis Zeile 8xx (letze Zeile Spalte B)?

[lpterritory]

Ja genau, wenn ich richtig liege müssten alle mitgenommen werden, glaube aber ab Zeile 3 bis Ende, weil da fangen erst die Messwerte an :O  

Es ist im Prinzip so: jede Zeile steht für eine 1/12 Sekunde. Und pro 1/12 Sekunde werden 2 Koordinaten aufgelistet. Es gibt aber teilweise Zeitabschnitte, wo keine Koordinaten aufgenommen werden, das sind dann genau diese Leerzeilen, wo keine Werte in allen Spalten zu finden sind. Diese müssen jedoch dennoch berücksichtigt werden, da ja sonst die Messergebnisse verfälscht würden und die Zeit innerhalb dieser Leerzeilen ja auch vergeht.
Danke dir für deine anhaltenden Bemühungen

[lpterritory]

EDIT: ich glaube so ists besser formuliert: also beachtet werden, sollen die Leerzeilen relativ zu den Werten in den andren spalten. Also praktisch die Differenz der Leerzeilen von Anfang (wobei das immer der erste wert nach Ende eine spalte ist) bis zum ersten wert - Anzahl der spalten mit Werten der spalten links davon. Die Differenz ergibt dann praktisch jeweils die Leerzeilen zwischen den Werten.

Ganz einfach formuliert einmal die Abfolge: spalte B C D  dann Leerzeilen (wenn vorhanden) darunter dann spalte E F G

[schauan]

Hallöchen,

ich hab hier jetzt erst mal die Leerzeilen jeweils ab Zeile 3 bis zum ersten Eintrag der jeweiligen Reihe mitgenommen. Wäre das so korrekt?

Modul Modul2

Sub Makro2() 
'Variablendeklarationen 
'Long 
Dim lLRow&, lLCol& 
    'Mit dem aktiven Blatt 
    With ActiveSheet 
      'erst mal in Spalte A und B Leerzeichen entfernen 
      .Columns(1).Replace What:=" ", Replacement:="", LookAt:=xlPart 
      .Columns(2).Replace What:=" ", Replacement:="", LookAt:=xlPart 
      'erste zu kopierende Datenspalte aktivieren 
      .Cells(1, 5).Activate 
      'Solange in der aktiven Zelle Daten stehen 
      Do While ActiveCell.Value <> "" 
        'letzte belegte zelle in Spalte B feststellen (zum spaeteren Einfuegen) 
        lLRow = .Cells(Rows.Count, 2).End(xlUp).Row 
        lLCol = ActiveCell.Column 
        'eventuelle Leerzeichen entfernen - scheinbar leere Zellen haben alle eins ... 
        .Range(ActiveCell.Resize(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, 3).Address).Replace What:=" ", Replacement:="", LookAt:=xlPart 
        'sicherheitshalber nachschauen, ob was zu tun ist - anhand nicht leerer Zellen 
        If WorksheetFunction.Subtotal(103, .Range(ActiveCell.Resize(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, 3).Address)) > 3 Then 
          'sichtbare Zellen im Datenbereich kopieren 
          .Range(ActiveCell.Offset(2).Resize(.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row - 2, 3).Address).SpecialCells(xlVisible).Copy 
          'und an Spalte B (und C und D) anhaengen 
          .Cells(lLRow + 1, 2).PasteSpecial Paste:=xlPasteValues 
        'Ende sicherheitshalber nachschauen, ob was zu tun ist - anhand nicht leerer Zellen 
        End If 
        'naechste Zelle aktivieren - 3 Spalten weiter 
        Cells(1, lLCol).Offset(0, 3).Activate 
      'Ende Solange in der aktiven Zelle Daten stehen 
      Loop 
   'Ende Mit dem aktiven Blatt 
   End With 
End Sub 

[lpterritory]

Hallöchen,

ja das ist jetzt fast korrekt, allerdings müsste der Startpunkt noch dynamisch sein und nicht auf Zeile 3 festgelegt. Also sagen wir zum Beispiel in Spalte A, B und C gehen die Werte bis Zeile 23 aber die Werte von Spalte D E F fangen erst bei Zeile 26 an. Also hätte man ja 3 Leerstellen und genau, die müssen auch bei der Untereinanderreihung auftauchen. Das wären ja nicht direkt die Leerstellen vom Anfang des Datenblatts bis zu Beginn der Daten in einer Spalte, sondern die Leerstellen von Ende einer Spalte zu Beginn der nächsten.

Vielen Dank für deine Hilfe!

[schauan]

Hallöchen,

noch eine Zwischenfrage. Es kann doch auch passieren, dass eine Reihe wieder ganz oben (oder weiter oben?) beginnt. Dann kommt keine leere Zeile dazwischen?