Formel in VBA berechnen und Wert in Zelle schreiben

[DasmachtkeinenSpaß]

Hallo,

ich benötige als VBA-Anfänger Hilfe.

Im Internet habe ich einen Code gefunden, der nach ein paar Anpassungen nun so aussieht:

Code:

Public Sub Workbook_Open()
Dim Bereich As Range, rngZellen As Range

Application: Sheets("Test").Activate

Set Bereich = Intersect(Columns(12), Worksheets("Test").UsedRange.Offset(15, 0))

If Not Bereich Is Nothing Then
With Application
  .ScreenUpdating = False
  .EnableEvents = False
         Set Bereich = Bereich.Offset(0, 1)
       
         Bereich.FormulaR1C1 = "=If(RC[-1]<>"""",True,"""")"
       
         On Error Resume Next
            Set rngZellen = Bereich.SpecialCells(xlCellTypeFormulas, 13)
            Bereich.Value = ""
         On Error GoTo 0
       
         If Not rngZellen Is Nothing Then

          rngZellen.FormulaR1C1 = "=RC[-1]-TODAY()"
        
            For Each rngZellen In Bereich.SpecialCells(xlCellTypeFormulas)
            IfTrim(rngZellen.Text) <> "" Then rngZellen.Value = rngZellen.Value
            Next

         End If
  .ScreenUpdating = True
  .EnableEvents = True
End With
End If

End Sub

Der Code funktioniert einwandfrei.

Problem ist nur, dass die Spalte L nicht immer eingeblendet ist. Dies hat zur Folge, dass die Formel nicht entfernt wird.
Als Lösung hatte ich gedacht die Formel zu berechnen und nur den Wert in die Zelle eintragen zu lassen.
Es gibt viele Beiträge zu diesem Thema, aber ich schaffe die Anpassung nicht.

Kann mir bitte jemand helfen?
Vielen Dank!

[DasmachtkeinenSpaß]

Hallo,

hat niemand eine Idee?

Viele Grüße

[Elex]

Hi

Wenn nicht ganz klar ist was Gesucht/Gebraucht wird, hat meist keiner Lust Nachzufragen.
Stell deine Ausgangslage vor und was du am Ende erreichen möchtest.

Gruß Elex

[BoskoBiati]

Hi,

einfachste Variante:

prüfen ob Spalte L ausgeblendet, wenn ja, einblenden, Formel durch Werte ersetzen, wieder ausblenden.

[DasmachtkeinenSpaß]

Hi Elex,

vielen Dank für deine Nachricht! 

Ok, sorry. Mein Fehler. Habe jetzt eine Beispieldatei beigefügt.

Es geht darum, dass in Spalte L (nicht in jeder Zeile) ein Datum steht. In Spalte M wird die Differenz zum aktuellen Tagesdatum berechnet, wenn die Nachbarzelle (Spalte L) nicht leer ist.

Die erfolgt mit dem unten stehenden Code. Die Formel wird eingetragen, berechnet und dann wieder gelöscht.

Sollte aber Spalte M ausgeblendet sein, erfolgt zwar die Berechnung, aber die Formel wird nicht entfernt (siehe Bespieldatei). Was in der Folge zu Problemen führt...

Jetzt habe ich gedacht, um das Problem zu umgehen, nur das Ergebnis in die jeweiligen Zellen eintragen zu lassen.

Ich hatte mal einen Code gefunden:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("L")) Is Nothing And Target.Count = 1 Then
If IsDate(Range("L16")) Then
Range("M16:M50000") = "=IF(RC[-1]>0, DATEDIF(TODAY(), RC[-1],""d""), """")"
End If
End If
End Sub

Dieser Code macht eigentlich was ich möchte (habe ihne der Bespieldatei hinzugefügt). Nur ich möchte dies nicht als Change-Ereignis haben.

Ich hoffe meine Ausführungen sind verständlic.

@BoskoBiati habe ich nicht so richtig hinbekommen. Nur in der Form, dass die Spalte immer eingeblendet wird. Das soll nicht sein...

Gruß

[Elex]

Soweit klarer. 

Aber

Dieser Code macht eigentlich was ich möchte (habe ihne der Bespieldatei hinzugefügt). Nur ich möchte dies nicht als Change-Ereignis haben.

Jetzt weis ich was du nicht möchtest. Aber nicht wie du es möchtest.
per Doppelklick und dann nur für die Zelle oder DK und dann für alle oder?
Warum nicht Change und das immer nur für die Zelle M wo L geändert wird.

[DasmachtkeinenSpaß]

Die Tabelle wird immer mit oder ohne einem Datum in Spalte L befüllt und dann gespeichert und geschlossen.

Danach erfolgen zwar noch Änderungen in der Tabelle, aber die Datumsdifferenz muss dann schon vorliegen. Deshalb nicht change.

Die Datumsdifferenz soll beim (wieder)öffnen der Datei täglich neu berechnet werden, wenn in Spalte L ein Datum vorhanden ist.  

War dies verständlich?

[Elex]

Dann versuch es mal so.

Code:

Public Sub Workbook_Open()
Dim a

On Error Resume Next
With Sheets("Test")
  .Range("L16:L" & .UsedRange.Rows.Count).SpecialCells(xlCellTypeBlanks).Offset(, 1).ClearContents
  For Each a In .Range("L16:L" & .UsedRange.Rows.Count).SpecialCells(xlCellTypeConstants).Cells
    a.Offset(, 1) = DateDiff("d", Date, a)
  Next a
End With
End Sub

Gruß Elex

[DasmachtkeinenSpaß]

Hi Elex,

es funktioniert. Vielen Dank!

Versuche dann mal den Code zu verstehen.

Frohe Pfingsten!

Gruß