Danke, Link habe ich gelesen, hilft mir aber leider nicht ganz um auf die Lösung zu kommen.
Formel 1:
Spalte LA5 bis BOJ1 soll ausgefüllt werden.
Wenn BPK2 = HK2 ' Dieser Wert bleibt immer gleich zum prüfen bei jeder Spalte
Und LA3 = 0, ' Dieser Wert wird pro Spalte geprüft wo berechnet wird bis BOJ3
Und BQC3 = 1 'Dieser Wert wird pro Spalte geprüft wo berechnet wird bis DTL3
Und LA1 >= LA36 `Dieser Wert wird pro Spalte geprüft wo berechnet wird bis DTL1/36
Und LA1 <= LA37 `Dieser Wert wird pro Saplte geprüft wo berechnet wird bis DTL1/37
Wenn Ja, LA5 =1 `Dieser Wert wird pro Spalte angezeigt wo berechnet wurde bis DTL5
Wenn Nein, LA5 = 0
Soweit die Erklärung.
With Worksheets("Sheet1")
ggga = .Range("LA1").Column
gggb = .Range("BOJ1").Column
gggc = .Range("BQC1").Column
gggd = .Range("DTL1").Column
For ggge = ggga To gggb
For gggf = gggc To gggd
If .Cells("BPK2").Value = .Cells("HX2") And _
.Cells(ggge, 3).Value = "0" And _
.Cells(gggf, 3).Value = 1 And _
.Cells(ggge, 1).Value >= .Cells(ggge, 36) And _
.Cells(ggge, 1).Value <= .Cells(ggge, 37) Then
.Cells(ggge, 5).Value = "1"
Else
.Cells(ggge, 5).Value = "0"
End If
Next
End With
Formel 2:
Wenn LA3 = 1 ' Soll pro Spalte geprüft werden bis BOJ3
Und LA12 > "" ' Soll pro Saplte geprüft werden bis BOJ3
Dann LA13:14 kopieren und Einfügen BQC13 'Ebenfalls Verschiebung pro Spalte wo berechnet wird bis BOJ13:14 und Einfügen bis DTL13
With Worksheets("Sheet1")
Dim gggq As Long
For gggq = 12 To 13
gggj = .Range("LA1").Column
gggk = .Range("BOJ1").Column
gggl = .Range("BQC1").Column
gggm = .Range("DTL1").Column
For gggn = gggj To gggk
For gggo = gggl To gggm
If .Cells(gggn, 3).Value = "1" And _
.Cells(gggn, 12).Value > "" Then
.Range(gggn, gggq).Copy Range(gggl, 13)
End If
Next
End With
Hoff ich konnte so ein wenig Licht ins dunkle bringen. Mit den Standart Formeln komme ich klar, nur wenn ich mehrere Eigenschaften gleichzeitig benötige ist es noch schwierig.
|