Wechsel von positiv Wert nach neagtiv Wert

Hallo Zusammen,
folgende Herausforderung mit der ich nicht klarkomme und Euch um Hilfe bitte:
Die Rohdaten einer Messung liegen als Wertepaare für ein XY-Diagramm vor, das sich über alle Quadranten des kartesischen Koordinatensystems zieht. Mich interessiert aber nur ein Quadrant.
In Spalte A (x-Achse) beginnen die Werte im positiven Bereich und werden erst größer und dann kleiner. Es wird die Zelle in Spalte A gesucht wo sich der positive Wert auf einen negativen Wert ändert. Ab dieser Zelle sollen die Zellen in Spalte A und B farbig unterlegt werden bis in Spalte B (Y-Achse) ebenfalls sich ebenfalls der positive Wert auf einen neativen Wert ändert. Danach sollte der farbigmarkierte Bereich nach Spalte D und E kopiert werden.
In dem Upload habe ich dies zur Verdeutlichung einmal manuell gemacht.
https://www.herber.de/bbs/user/69555.xls
Leider ist die Anzahl der Wertepaare von Messung zu Messung nicht immer gleich und es gibt auch keinen definierten Wert 0.
Ich hoffe jemand von Euch kann mir hier weiterhelfen. Vielen Dank einstweilen.
Gruß
Johannes

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Rudi,
erstmal Danke für den Tip.
Ich habe folgendes daraus weitergebaut:

Sub M1()
Dim Zeile As Variant
Zeile = ActiveSheet.UsedRange.Rows.Count
Range("D2").Select
ActiveCell.FormulaR1C1 = "=IF(AND(RC[-3]0),RC[-3],"""")"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=IF(AND(ISNUMBER(RC[-1]),RC[-3]>0),RC[-3],"""")"
Range("D2:E2").Select
Selection.Copy
Range("D3:D" & Zeile).Select
ActiveSheet.Paste
Columns("D:E").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("D1").Select
Application.CutCopyMode = False
For Each D In Worksheets("Rohdaten").Range("D1:D" & Zeile).Cells
If D.Value = "" Then D.Value = ""
Next
On Error Resume Next
Application.Intersect(Range("D1:D" & Zeile), _
Cells.SpecialCells(xlCellTypeBlanks)).EntireRow.Delete
End Sub

Allerdings sollte nicht die ganzen Zeilen gelöscht werden sonder es wäre besser nur die Zellen in Spalte D und E. Das müsste doch auch gehen - ich finde nur leider nichts in den Archivlisten dazu.
Hast Du hierzu einen Tip?
Gruß
Johannes

Sub M1() Dim Zeile As Variant Zeile = ActiveSheet.UsedRange.Rows.Count Range(Cells(2, 4), Cells(Zeile, 4)).FormulaR1C1 = _ "=IF(AND(RC[-3]0),RC[-3],"""")" Range(Cells(2, 5), Cells(Zeile, 5)).FormulaR1C1 = _ "=IF(AND(ISNUMBER(RC[-1]),RC[-3]>0),RC[-3],"""")" With Range(Cells(2, 4), Cells(Zeile, 5)) .Value = .Value .SpecialCells(xlBlanks).Delete shift:=xlUp End With End Sub

Beliebteste Forumthreads (12 Monate)

	A	B	C	D	E	F
1	X-Achse	Y-Achse		X-Achse	Y-Achse	Hilf
2	239,1	0,01050		-1,9	0,25219	198

Wechsel von positiv Wert nach neagtiv Wert

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread