Hallo Lona,
offenbar wurde dein Code unvollständig übertragen. Es fehlen die Zeilen, in denen pWs und pWs2 Werte zugewiesen werden (Set pWs = Worksheets("...")). lngRow_max bleibt immer 0, dblWegMax_alt wird kein Wert zugewiesen, so dass die lange Bedingung
If (dblSteigung_alt > 0 And dblSteigung dblWegMax_alt * (1 + 0.05) And dblWegMax_alt > 0) Then
nie erfüllt werden kann und somit die Wertezuweisung darunter nie erfolgt.
Ich vermute, dass dir die Forum-SW einen Streich gespielt hat, die Größer- und Kleinerzeichen teilweise als Steuerzeichen versteht. Ändere diese Zeichen in "größer" und "kleiner" und sende deinen neuen Code noch einmal.
Nachstehend zeige ich dir, was ich mit mehrdimensionealen Array meinte. Wenn es dir gelingt, etwas klarer zu sagen, was ds Ziel ist, kann ich dir vielleicht besser helfen.
Set pWs = Worksheets("...")
Set pWs2 = Worksheets("...")
ReDim Stufen(2, 1 To 1)
lngRow_max = 0
'For lngRow = 12 To ActiveSheet.UsedRange.Rows.Count
For lngRow = 2 To Cells(Rows.Count, 1).End(xlUp).Row
dblSteigung_alt = dblSteigung
dblSteigung = Cells(lngRow, 1) - Cells(lngRow - 1, 1)
If dblSteigung_alt kleiner 0 Then ' Minimum gefunden 'Warum ..._alt??????? Soll wohl kleiner heißen?
lngRow_min2 = lngRow_min1
lngRow_min1 = lngRow
End If
If dblSteigung_alt kleiner 0 And dblSteigung Operator dblWegMax_alt * (1.05) And dblWegMax_alt größer 0 Then 'was ist dblWegMax_alt?? Welcher Operator, vermutlich kleiner?
If (Stufen(0, UBound(Stufen, 2)) größer 0) Then ReDim Preserve Stufen(2, 1 To UBound(Stufen, 2) + 1)
Stufen(0, UBound(Stufen, 2)) = lngRow_max
Stufen(1, UBound(Stufen, 2)) = lngRow_min1
Stufen(2, UBound(Stufen, 2)) = lngRow_min2
End If
Next lngRow
'Ende der daten Letzte Stufe merken
For i = 1 To UBound(Stufen, 2) 'Überscheibst du nicht jedesmal deine Werte auf pWs2?
Stufen(0,i) 'was fehlt hier?
pWs.Range("A" & Stufen(2, i) & ":" & "B" & Stufen(1, i)).Copy Destination:=pWs2.Range("A1")
Next i
Wenn es dir gelingt, etwas klarer zu sagen, was ds Ziel ist, kann ich dir vielleicht besser helfen. Wie definieren sich Stufe und Zyklus? Gibt vielleicht eine charakterische Zahlenfolge hiervon.
Gruß
Holger
Lona schrieb am 10.03.2009 11:21:11:
Hallo Holger,
Danke für deine Bemühungen, ich habe es probiert aber es kommt die gleiche Fehlermeldung.
Gruss
Lona
Holger schrieb am 10.03.2009 09:49:56:
Hallo Lona,
nur ein paar Anmerkungen, da ich keine Zeit habe:
1. Du nennst deinen Typ StufenTyp, verwendest aber später nur Stufen. Beide Bezeichnungen müssen gleich sein.
2. Mit einem benutzerdefinierten Typ kann man m.E. kein Array bilden, nur mit den elementen des Typs.
Wenn du die gesamten Zwischenwerte brauchst, empfehle ich dir, dies über ein mehrdimensionales Array zu organisieren, wie ich es bereits angedeutet hatte.
Vielleicht komme ich heute im Laufe des Tages noch dazu, dein Makro etwas näher anzusehen. Dann melde ich mich noch einmal.
Gruß
Holger
Lona schrieb am 09.03.2009 14:23:03:
hallo Hoger,
danke für die Hilfe, ich habe bei Definitionen:
Public Type StufenTyp
Row_min1 As Long
Row_min2 As Long
Row_max As Long
End Type
Ich habe mit deinem Vorschlag probiert aber es kommt trotzdem Fehlermeldung.
Hier ich das komplette Code schicken:
Private Sub FilterButton_Click()
Dim lngRow As Long, pWs As Worksheet, pWs2 As Worksheet, lngRow_min1 As Long, lngRow_min2 As Long, lngRow_max As Long, dblSteigung As Double, _
dblSteigung_alt As Double, dblWegMax As Double, dblWegMax_alt As Double, i As Variant
ReDim Stufen(1 To 1)
lngRow_max = 0
For lngRow = 12 To ActiveSheet.UsedRange.Rows.Count
dblSteigung_alt = dblSteigung
dblSteigung = ActiveSheet.Range("A" & lngRow).Value - ActiveSheet.Range("A" & lngRow - 1).Value
If (dblSteigung_alt 0) Then ' Minimum gefunden
lngRow_min2 = lngRow_min1
lngRow_min1 = lngRow
End If
If (dblSteigung_alt > 0 And dblSteigung dblWegMax_alt * (1 + 0.05) And dblWegMax_alt > 0) Then
If (Stufen(UBound(Stufen)).Row_max > 0) Then ReDim Preserve Stufen(LBound(Stufen) To UBound (Stufen) + 1)
Stufen(UBound(Stufen)).Row_max = lngRow_max
Stufen(UBound(Stufen)).Row_min1 = lngRow_min1
Stufen(UBound(Stufen)).Row_min2 = lngRow_min2
End If
Next lngRow
'Ende der daten Letzte Stufe merken
For i = LBound(Stufen) To UBound(Stufen)
Stufen(i).Row_max
pWs.Range("A" & Stufen(i).Row_min2 & ":" & "B" & Stufen(i).Row_min1).Copy Destination:=pWs2.Range("A1:")
Next i
End Sub
meine Aufgabe ist:
Im Rahmen einer Automatisierungsablauf, Ich habe x und y Werte als Excel-Datei ( mehr als 10000) von einer Versuch und dazugehörige Diagramm. Laut Diagramm stellen diese Kurven Zyklen von verschiedenen Stufen dar.
Die Anzahl der stufen und Zyklen variiert sich.
Ziel ist : das letzte Zyklus von jeder Stufe muss ich raus finden, in einer anderen Arbeitsmappe kopieren und das zugehörige Diagramm darstellen.
Danke
Gruß
Lona
Holger schrieb am 09.03.2009 13:24:46:
Hallo Lona,
hast du vorher ein Objekt Stufen() mit den verwendeten Eigenschaften Row_max, Row_min1 und Row_min2 definiert? Oder willst du nur ein Array in seiner Größe verändern? Ich vermute, dein Array hat zwei Dimensionen, wobei jedem Wert von "Stufe"(?) ein Wert lngRow_max, lngRow_min1 und lngRow_min2 zugeordnet werden soll, also wurde das Array als Stufen(2,n) dimensioniert, wobei n eine veränderliche Zahl sein soll, da es für eine Erweiterung vorgesehen ist.
UBound(Stufen,2) gibt dir das bisherige n zurück.
ReDim Preserve Stufen(2,UBound(Stufen,2)+1) fügt dem Array eine neue leere Zeile hinzu, ohne die bisherigen Daten zu verändern. Nur die letzte Dimension kann verändert werden!
Ich würde z.B.
a=UBound(Stufen,2)+1
redim preserve stufen(2,a)
stufen(0,a)=lngRow_max
stufen(1,a)=lngRow_min1
stufen(2,a)=lngRow_min2
verwenden. Es kann aber sein, dass dich total missverstanden habe.
Gruß
Holger
Lona schrieb am 09.03.2009 13:02:37:
Hallo liebe User :)
Ich hoffe ich bin hier richtig in diesem Forum und finde Hilfe...
If (dblWegMax > dblWegMax_alt * (1 + 0.05) And dblWegMax_alt > 0) Then
If (Stufen(UBound(Stufen)).Row_max > 0) Then ReDim Preserve Stufen(Stufen(LBound(Stufen)) To UBound (Stufen) + 1)
Stufen(UBound(Stufen)).Row_max = lngRow_max
Stufen(LBound(Stufen)).Row_min1 =
Stufen(LBound(Stufen)).Row_min2 = lngRow_min2
End If
Wenn ich das Programm laufen lasse, meldet Fahler (objekt erforderlich ) bei :
If (Stufen(UBound(Stufen)).Row_max > 0) Then
Kann mir jemand helfen und mir sagen , was ich in diesem code falsch geschrieben habe.
danke im Voraus
|