Hallo zusammen,
ich sitze vor einem etwas komplexeren Problem und brauche eure Hilfe!
Um einen großen Datensatz auf eine Kaufentscheidung hin zu analysieren, habe ich Prämissen definiert. Dazu wird eine Kaufentscheidung ausgelöst, wenn der Wert der Zelle um 3% größer ist als ein Referenzwert.
Die Prämissen sind die folgenden:
A) Der Referenzwert wird neu gesetzt, wenn neben der vorherigen Zelle der Wert "BUY" eingetragen wurde (Also wenn gerade eingekauft wurde):
DIESER SUB FUNKTIONIERT
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | Sub LoopE()
ActiveWorkbook.Sheets( "AP1" ). Select
Dim x As Integer
For x = 2 To 2000 Step 1
If Cells(x, 4).Offset(1, 0) = "BUY" Then
With Cells(x, 5).Offset(1, 0)
.Value = "REF"
.Interior.Color = RGB(0, 255, 0)
End With
Else
End If
Next
End Sub
|
B) Der Referenzwert wird neu gesetzt, wenn der Wert der aktuellen Zelle kleiner ist als der Wert der vorhergehenden Zelle:
DIESER SUB FUNKTIONIERT NOCH NICHT
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | Sub LoopZ()
ActiveWorkbook.Sheets( "AP1" ). Select
Dim x As Integer
Dim y As Integer
For x = 2 To 2000 Step 1
For y = 1 To 2000 Step 1
If Cells(x, 2).Offset(1, 0) > Cells(y, 2).Offset(1, 0) Then
With Cells(x, 5).Offset(1, 0)
.Value = "REF"
.Interior.Color = RGB(0, 255, 0)
End With
Else
Cells(x, 5).Offset(1, 0) = "NO REF"
Cells(x, 5).Offset(1, 0).Interior.ColorIndex = 6
End If
Next
End Sub
|
C) Ist der Wert der aktuellen Zelle um 3% höher als ein Referenzwert, so wird in die benachbarte Zelle der Wert "BUY" eingetragen (Also die Kaufentscheidung ausgelöst):
DIESER SUB FUNKTIONIERT NOCH NICHT
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | Sub LoopX()
ActiveWorkbook.Sheets( "AP1" ). Select
Dim x As Integer
Dim y As Integer
For x = 2 To 2000 Step 1
For y = 1 To 2000 Step 1
If Cells(x, 2).Offset(1, 0) > (1.03 * (Cells(y, 2).Offset(1, 0))) Then
With Cells(x, 4).Offset(1, 0)
.Value = "BUY"
.Interior.Color = RGB(0, 255, 0)
End With
Else
Cells(x, 4).Offset(1, 0) = "NO BUY"
Cells(x, 4).Offset(1, 0).Interior.ColorIndex = 6
End If
Next
End Sub
|
Ganz herzlichen Dank im Vorraus!
|