Wenn Zahl aus Tab1(mit Datum in Unterzelle),Anzeige Tab 2 + X Monate

HAllo Klaus,

Die ist Super die Formel muss aber gleich +4Monate und ab Zahl 80 +6Monate anzeigen und bei überschreitung sich Rot Färben(ansonsten grün).Werde noch EDatum zur Formel hinzufügen wenn ich es hinbekomme.Sobald ich Zeit habe probiere ich es aus

Danke für deine Hilfe.

Das mit den "X-Monaten" macht nicht wirklich Sinn.

Wenn Du eine Spalte mit einem Datum hast, dann kann man via EDATUM dieses leicht in die Zukunft umrechnen.

Kann man auch mit VBA machen, klar...

Anschließend machst Du Dir eine bedingte Formatierung auf die Spalte, z.B.:





Andreas.





Option Explicit

Sub Test()

Dim All As Range, R As Range

Dim C As New Collection

Dim Item, Data

Dim i As Long



'Suche alles in B:G

Set All = FindAll(Range("B:G"), "*")

'Jede gefundene

For Each R In All

'Ist es eine Zahl?

If IsNumeric(R.Value) Then

'Mit Datum merken

C.Add Array(R.Value, R.Offset(1).Value)

End If

Next



'Liste zusammenstellen

ReDim Data(1 To C.Count, 1 To 2)

For Each Item In C

i = i + 1

Data(i, 1) = Item(0) 'Zahl

Data(i, 2) = Item(1) 'Datum

Data(i, 2) = DateAdd("m", 1, Data(i, 2)) 'Ein Monat weiter

Next

'In die Tabelle schreiben

Sheets("Tabelle2").Range("A1").Resize(UBound(Data), UBound(Data, 2)).Value = Data

End Sub

Function FindAll(ByVal Where As Range, ByVal What, _

Optional ByVal After As Variant, _

Optional ByVal LookIn As XlFindLookIn = xlValues, _

Optional ByVal LookAt As XlLookAt = xlWhole, _

Optional ByVal SearchOrder As XlSearchOrder = xlByRows, _

Optional ByVal SearchDirection As XlSearchDirection = xlNext, _

Optional ByVal MatchCase As Boolean = False, _

Optional ByVal SearchFormat As Boolean = False) As Range

'Find all occurrences of What in Where (Windows version)

Dim FirstAddress As String

Dim C As Range

'From FastUnion:

Dim Stack As New Collection

Dim Temp() As Range, Item

Dim i As Long, j As Long

If Where Is Nothing Then Exit Function

If SearchDirection = xlNext And IsMissing(After) Then

'Set After to the last cell in Where to return the first cell in Where in front if _

it match What

Set C = Where.Areas(Where.Areas.Count)

'BUG in XL2010: Cells.Count produces a RTE 6 if C is the whole sheet

'Set After = C.Cells(C.Cells.Count)

Set After = C.Cells(C.Rows.Count * CDec(C.Columns.Count))

End If

Set C = Where.Find(What, After, LookIn, LookAt, SearchOrder, _

SearchDirection, MatchCase, SearchFormat:=SearchFormat)

If C Is Nothing Then Exit Function

FirstAddress = C.Address

Do

Stack.Add C

If SearchFormat Then

'If you call this function from an UDF and _

you find only the first cell use this instead

Set C = Where.Find(What, C, LookIn, LookAt, SearchOrder, _

SearchDirection, MatchCase, SearchFormat:=SearchFormat)

Else

If SearchDirection = xlNext Then

Set C = Where.FindNext(C)

Else

Set C = Where.FindPrevious(C)

End If

End If

'Can happen if we have merged cells

If C Is Nothing Then Exit Do

Loop Until FirstAddress = C.Address

'FastUnion algorithm © , 2011:

'Get all cells as fragments

ReDim Temp(0 To Stack.Count - 1)

i = 0

For Each Item In Stack

Set Temp(i) = Item

i = i + 1

Next

'Combine each fragment with the next one

j = 1

Do

For i = 0 To UBound(Temp) - j Step j * 2

Set Temp(i) = Union(Temp(i), Temp(i + j))

Next

j = j * 2

Loop Until j > UBound(Temp)

'At this point we have all cells in the first fragment

Set FindAll = Temp(0)

End Function

Hier der Link

https://1drv.ms/x/s!AlLJ_d394eTxq2rtpQRAoVzdYGPR

Und Danke im Voraus

Hallo Claudio,

folgende Formel zählt 4 Monate dazu, wenn in Spalte A die Werte kleiner gleich 80 sind und 6 Monate zu den Werten über 80:

=WENNFEHLER(EDATUM(INDIREKT("Tabelle1!"&ADRESSE(MAX((Tabelle1!$B$6:$G$327=$A6)*ZEILE($6:$327))+1;MAX((Tabelle1!$B$6:$G$327=$A6)*SPALTE(B:G))));WENN(A1<=80;4;6));"")

Auch diese Formel muss mit STRG+Shift+Enter eingegeben werden.

Claus

Hallo Andreas,

Danke für deine Mühe.

Ja die doppelten sind nur mal so testweise gewesen(Um zu probieren ob das Datum sich aktualisiert.).Diese Werden in der Endversion nicht vorkommen.

die mit Buchstaben muss ich halt schauen wie ich es mach.Werde dann berichten ob alles geklappt hat.

Danke für deine Hilfe.