AW: Nur ein Hinweis zum Layout der Ausgangsdaten
30.04.2019 18:49:08
Juri
Hallo zusammen,
ich hab diese Woche noch ein bisschen getüftelt und bin auch voran gekommen.
Trotzdem verzweifel ich gerade ein bisschen.
Da es an einem Tag unterschiedlich viele Messungen geben kann orientiere ich mich an der Spalte F. Dort lasse ich pro gefundenes "Gewicht" +1 auf einen Zähler addieren. Es wird maximal 4 Mal gemessem und min. 1 Mal. Als Orientierung für einen neuen Tag benutze ich die leere Zelle zwischen 2 Tagen in der Spalte F, da wird dann der Zähler auf gesetzt um wieder die Schleife bei 1. Messung anfangen zu lassen.
Da meine gesuchten Werte immer in definierten Abständen zu meinem gefundenen "Gewicht" sich befinden hab ich durch offset den zu kopierenden Bereich festgelegt und lasse es im Ausgabeblatte in der letzten unbeschriebenen Zeile der zugehörigen Spalte ausgeben.. Trotzdem funtkioniert es nicht so. Beim durchlaufen des Makros wirft es mit die falschen Werte aus
Sub Datenaufbereitung()
Dim Worksheet As Worksheet
Dim AusgabeSheet As Worksheet
Dim Zähler As Integer
Dim Suchzeille As Long
Worksheets("Ausgangsdaten").Activate
Zähler = 0
Set Worksheet = ThisWorkbook.Worksheets("Ausgangsdaten")
Set AusgabeSheet = ThisWorkbook.Worksheets("Daten für Diagramm")
For SuchZeile = 4 To Worksheet.Cells(Rows.Count, 6).End(xlUp).Row
If Worksheet.Range("F" & SuchZeile).Value = "Gewicht" Then
If Zähler = 0 Then 'Erste Messung für Datum
ActiveCell.Offset(0, -4).Resize(1, 4).Copy '4 Gewichte kopieren
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 3).End(xlUp).Row + 1
AusgabeSheet.Range("C" & AusgabeZeile).PasteSpecial xlPasteValues
End With
ActiveCell.Offset(-2, -5).Resize(1, 1).Copy 'Datum
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 1).End(xlUp).Row + 1
AusgabeSheet.Range("A" & AusgabeZeile).PasteSpecial
End With
ActiveCell.Offset(-1, -5).Resize(1, 1).Copy 'Schicht
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 2).End(xlUp).Row + 1
AusgabeSheet.Range("B" & AusgabeZeile).PasteSpecial
End With
ActiveCell.Offset(1, -5).Resize(1, 1).Copy 'Bemerkung
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 7).End(xlUp).Row + 1
AusgabeSheet.Range("G" & AusgabeZeile).PasteSpecial
End With
Zähler = Zähler + 1
End If
If Zähler = 1 Then 'Zweite Messung für Datum
ActiveCell.Offset(0, -4).Resize(1, 4).Copy '4 Gewichte kopieren
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 3).End(xlUp).Row + 1
AusgabeSheet.Range("C" & AusgabeZeile).PasteSpecial xlPasteValues
End With
ActiveCell.Offset(-5, -5).Resize(1, 1).Copy 'Datum
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 1).End(xlUp).Row + 1
AusgabeSheet.Range("A" & AusgabeZeile).PasteSpecial
End With
ActiveCell.Offset(-4, -5).Resize(1, 1).Copy 'Schicht
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 2).End(xlUp).Row + 1
AusgabeSheet.Range("B" & AusgabeZeile).PasteSpecial
End With
ActiveCell.Offset(-2, -5).Resize(1, 1).Copy 'Bemerkung
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 7).End(xlUp).Row + 1
AusgabeSheet.Range("G" & AusgabeZeile).PasteSpecial
End With
Zähler = Zähler + 1
End If
If Zähler = 2 Then 'Dritte Messung für Datum
ActiveCell.Offset(0, -4).Resize(1, 4).Copy '4 Gewichte kopieren
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 3).End(xlUp).Row + 1
AusgabeSheet.Range("C" & AusgabeZeile).PasteSpecial xlPasteValues
End With
ActiveCell.Offset(-8, -5).Resize(1, 1).Copy 'Datum
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 1).End(xlUp).Row + 1
AusgabeSheet.Range("A" & AusgabeZeile).PasteSpecial
End With
ActiveCell.Offset(-7, -5).Resize(1, 1).Copy 'Schicht
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 2).End(xlUp).Row + 1
AusgabeSheet.Range("B" & AusgabeZeile).PasteSpecial
End With
ActiveCell.Offset(-5, -5).Resize(1, 1).Copy 'Bemerkung
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 7).End(xlUp).Row + 1
AusgabeSheet.Range("G" & AusgabeZeile).PasteSpecial
End With
Zähler = Zähler + 1
End If
If Zähler = 3 Then 'Vierte Messung für Datum
ActiveCell.Offset(0, -4).Resize(1, 4).Copy '4 Gewichte kopieren
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 3).End(xlUp).Row + 1
AusgabeSheet.Range("C" & AusgabeZeile).PasteSpecial xlPasteValues
End With
ActiveCell.Offset(-11, -5).Resize(1, 1).Copy 'Datum
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 1).End(xlUp).Row + 1
AusgabeSheet.Range("A" & AusgabeZeile).PasteSpecial
End With
ActiveCell.Offset(-10, -5).Resize(1, 1).Copy 'Schicht
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 2).End(xlUp).Row + 1
AusgabeSheet.Range("B" & AusgabeZeile).PasteSpecial
End With
ActiveCell.Offset(-8, -5).Resize(1, 1).Copy 'Bemerkung
With Sheets("Daten für Diagramm")
AusgabeZeile = AusgabeSheet.Cells(.Rows.Count, 7).End(xlUp).Row + 1
AusgabeSheet.Range("G" & AusgabeZeile).PasteSpecial
End With
Zähler = Zähler + 1
End If
End If
If Worksheet.Range("F" & SuchZeile).Value = "" Then
Zähler = 0
End If
Next SuchZeile
End Sub
ich hoffe ihr könnt mir helfen
Juri