Clever-Excel-Forum

Seiten: 1 2

Hallo!

Ich habe folgenden bestehenden Code:

Code:
' immmer mit Option explicit arbeiten !

' nicht nur hinschreiben, sondern auch TUN!

'''''''''''''''''''''''''''''''

Option Explicit  '!!!!!!!!!!!!!!!

'''''''''''''''''''''''''''''''

Private Sub Worksheet_Activate()

Dim lr As Long

Dim i As Long

Dim DifferenzletzteAktualisierungFonds1mitStichtag As String

Dim DifferenzletzteAktualisierungFonds1seitAbschluss As String

Dim DifferenzletzteAktualisierungFonds2mitStichtag As String

Dim DifferenzletzteAktualisierungFonds2seitAbschluss As String

Dim DifferenzletzteAktualisierungFonds3mitStichtag As String

Dim DifferenzletzteAktualisierungFonds3seitAbschluss As String

Dim DifferenzletzteAktualisierungFonds4mitStichtag As String

Dim DifferenzletzteAktualisierungFonds4seitAbschluss As String

Dim fehlendeMonate As Integer

lr = Me.Cells(Me.Rows.Count, 1).End(xlUp).Row

If Me.Cells(lr, 1) < Date And WorksheetFunction.CountIf(Me.Range("A:A"), DateSerial(Year(Date), Month(Date), 1)) = 0 Then

  fehlendeMonate = DateDiff("m", Me.Cells(lr, 1).Value, Date)

  For i = 1 To fehlendeMonate

    lr = lr + 1

    Me.Cells(lr, 1).Value = DateSerial(Year(Date), Month(Date) - fehlendeMonate + i, 1)

    Me.Cells(lr, 3).Value = Worksheets("Comgest Growth Greater China").Range("H5").Value

    Me.Cells(lr, 4).Value = Worksheets("Comgest Growth Greater China").Range("H6").Value

    Me.Cells(lr, 6).Value = Worksheets("Fidelity Funds Global Technol").Range("H5").Value

    Me.Cells(lr, 7).Value = Worksheets("Fidelity Funds Global Technol").Range("H6").Value

    Me.Cells(lr, 9).Value = Worksheets("Fidelity Funds Global (Anspar)").Range("H5").Value

    Me.Cells(lr, 10).Value = Worksheets("Fidelity Funds Global (Anspar)").Range("H6").Value

    Me.Cells(lr, 12).Value = Worksheets("Fidelity Funds China Consumer").Range("H5").Value

    Me.Cells(lr, 13).Value = Worksheets("Fidelity Funds China Consumer").Range("H6").Value

    With Worksheets("Fondsentwicklungen")

        .Range("C2").Value = Me.Cells(lr, 3) - Me.Cells(lr - 1, 3)

        DifferenzletzteAktualisierungFonds1mitStichtag = .Range("C4").Value

        .Range("D2").Value = Me.Cells(lr, 4) - Me.Cells(lr - 1, 4)

        DifferenzletzteAktualisierungFonds1seitAbschluss = .Range("D4").Value

        .Range("F2").Value = Me.Cells(lr, 6) - Me.Cells(lr - 1, 6)

        DifferenzletzteAktualisierungFonds2mitStichtag = .Range("F4").Value

        .Range("G2").Value = Me.Cells(lr, 7) - Me.Cells(lr - 1, 7)

        DifferenzletzteAktualisierungFonds2seitAbschluss = .Range("G4").Value

        .Range("I2").Value = Me.Cells(lr, 9) - Me.Cells(lr - 1, 9)

        DifferenzletzteAktualisierungFonds3mitStichtag = .Range("I4").Value

        .Range("J2").Value = Me.Cells(lr, 10) - Me.Cells(lr - 1, 10)

        DifferenzletzteAktualisierungFonds3seitAbschluss = .Range("J4").Value

        .Range("L2").Value = Me.Cells(lr, 12) - Me.Cells(lr - 1, 12)

        DifferenzletzteAktualisierungFonds4mitStichtag = .Range("L4").Value

        .Range("M2").Value = Me.Cells(lr, 13) - Me.Cells(lr - 1, 13)

        DifferenzletzteAktualisierungFonds4seitAbschluss = .Range("M4").Value

    End With

    MsgBox "Die Fondsentwicklungensdaten wurden per " & Me.Cells(lr, 1) & " aktualisiert. " & String(1, vbNewLine) & _

    "Daraus ergeben sich folgende neue Werte, verglichen mit der letzten Aktualisierung vom " & Me.Cells(lr - 1, 1) & ": " & String(2, vbNewLine) & _

    "Comgest Growth Greater China:" & String(1, vbNewLine) & _

    "---------------------------------" & String(2, vbNewLine) & _

    "Prozentsatz mit Stichtag: " & Format(Me.Cells(lr, 3), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungFonds1mitStichtag & " %)" & String(1, vbNewLine) & _

    "Prozentsatz seit Abschluss: " & Format(Me.Cells(lr, 4), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungFonds1seitAbschluss & " %)" & String(2, vbNewLine) & _

    "Fidelity Funds Global Technol:" & String(1, vbNewLine) & _

    "------------------------------" & String(2, vbNewLine) & _

    "Prozentsatz mit Stichtag: " & Format(Me.Cells(lr, 6), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungFonds2mitStichtag & " %)" & String(1, vbNewLine) & _

    "Prozentsatz seit Abschluss: " & Format(Me.Cells(lr, 7), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungFonds2seitAbschluss & " %)" & String(2, vbNewLine) & _

    "Fidelity Funds Global (Anspar):" & String(1, vbNewLine) & _

    "-------------------------------" & String(2, vbNewLine) & _

    "Prozentsatz mit Stichtag: " & Format(Me.Cells(lr, 9), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungFonds3mitStichtag & " %)" & String(1, vbNewLine) & _

    "Prozentsatz seit Abschluss: " & Format(Me.Cells(lr, 10), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungFonds3seitAbschluss & " %)" & String(2, vbNewLine) & _

    "Fidelity Funds China Consumer:" & String(1, vbNewLine) & _

    "--------------------------------" & String(2, vbNewLine) & _

    "Prozentsatz mit Stichtag: " & Format(Me.Cells(lr, 12), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungFonds4mitStichtag & " %)" & String(1, vbNewLine) & _

    "Prozentsatz seit Abschluss: " & Format(Me.Cells(lr, 13), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungFonds4seitAbschluss & " %)" & String(2, vbNewLine)

  Next i

End If

aufräumen:

With Application

  .ScreenUpdating = True

  .EnableEvents = True

End With

With Worksheets("Fondsentwicklungen")

  .Activate

  .Cells(Rows.Count, 1).End(xlUp).Offset(1).Select

End With

End Sub

Nun möchte ich aber, dass nicht am 1. des Monats der 1. des Monats eingetragen wird sondern alle 12 Monate, aber nicht fix der 1. des Monats. Als Ausgangsdatum steht der Wert in der Zelle B4.
Lautet hier z.B. das Datum 22.11.2015 soll genau nach einem Jahr, sprich am 22.11.2016 der Wert 22.11.2016 in Spalte B5 eingetragen werden usw.., sofern ich die Excel-Datei öffne.

Ich hoffe, dass mir jemand weiterhelfen kann.

LG
Thomas

Hallöchen,

Setze die Bestandteile Day, Month und Year des bisherigen Datums neu zusammen und addiere dabei 1 zum Jahr

Im Prinzip

Code:
Sub test()

Dim a As Date

a = Date

b = CDate(Day(a) & "." & Month(a) & "." & Year(a) + 1)

End Sub

Hallo!

Nachdem ich mich in VBA nur sehr weniger auskenne und ich den bestehenden Code selbst von wo herbekommen habe, würde ich dich ersuchen mir zu helfen, wie ich deinen Code in meinen bestehenden Code genau einbinden soll bzw. kann?

Danke und

LG
Thomas

Hallo Thomas,

ich habe beim besten Willen im Code keine Stelle gefunden, die sich um B4 kümmert. Zudem ist es ein Code, der beim Aktivieren läuft und nicht beim Öffnen. Dein Wunsch passt da also gar nicht dazu.

Ich habe hier erst mal eine Formellösung, die Dir per Formel in B5 ein Jahr mehr einträgt. In B6 dann zwei wenn es soweit ist und in B7 drei usw.

Arbeitsblatt mit dem Namen 'Tabelle1'
	B
4	27.11.2015
5	27.11.2016
6	27.11.2017
7
8

Zelle	Formel
B5	=WENN(HEUTE()>=DATUM(JAHR($B$4)+ZEILE(B1);MONAT($B$4);TAG($B$4));DATUM(JAHR($B$4)+ZEILE(B1);MONAT($B$4);TAG($B$4));"")
B6	=WENN(HEUTE()>=DATUM(JAHR($B$4)+ZEILE(B2);MONAT($B$4);TAG($B$4));DATUM(JAHR($B$4)+ZEILE(B2);MONAT($B$4);TAG($B$4));"")
B7	=WENN(HEUTE()>=DATUM(JAHR($B$4)+ZEILE(B3);MONAT($B$4);TAG($B$4));DATUM(JAHR($B$4)+ZEILE(B3);MONAT($B$4);TAG($B$4));"")
B8	=WENN(HEUTE()>=DATUM(JAHR($B$4)+ZEILE(B4);MONAT($B$4);TAG($B$4));DATUM(JAHR($B$4)+ZEILE(B4);MONAT($B$4);TAG($B$4));"")

Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016

Diese Tabelle wurde mit Tab2Html (v2.5.3) erstellt. ©Gerd alias Bamberg

Hallo!

Im Code ist daweil auch noch nicht hinterlegt, dass er in B4 nachschauen soll. Der derzeitige Code bezieht sich nur auf Werte aus der Spalte A.
Übrigens, mit Öffnen habe ich eh Aktivieren gemeint.
Ich glaube nicht, dass ich ohne VBA dieses Problem lösen kann. Aber ich werde mir mal deine Formel ansehen.

Hallo nocheinmal!

Also, das mit der Formel funktioniert. Danke sehr.
Ich hätte mir zwar eine VBA Lösung gewunschen, aber mit dieser Lösung kann ich auch leben.

LG

Ich brauch doch eine VBA Lösung, weil ich nämlich zusätzlich zum Eintragen des Datums will, dass eine Messagebox erscheint, wenn genau ein Jahr vorbei ist.

Ich habe schon selbst etwas herumgebastelt, aber es funktioniert noch nicht ganz. In meinem Beispiel steht in Zelle A4 das Datum 05.12.2015. Wenn ich den nun von mir verwendeten Code nehme, schreibt er mir den 05.12.2016 und 05.12.2017 hin. Leider sollte er mir aber den 05.12.2017 noch nicht hinschreiben, weil ja heute erst der 28.11.2017 ist. Anbei mein aktueller Code, ich hoffe, dass mir jemand helfen kann.

Code:
lr = Me.Cells(Me.Rows.Count, 1).End(xlUp).Row

If Me.Cells(lr, 1) < Date And WorksheetFunction.CountIf(Me.Range("A:A"), DateSerial(Year(Date), Month(Range("A4")), Day(Range("A4")))) = 0 Then

  fehlendeJahre = DateDiff("yyyy", Me.Cells(lr, 1).Value, Date)

  For i = 1 To fehlendeJahre

    lr = lr + 1

    Me.Cells(lr, 1).Value = DateSerial(Year(Date) - fehlendeJahre + i, Month(Range("A4")), Day(Range("A4")))

LG
Thomas

Hallöchen,

das könnte man im Prinzip so lösen:

PHP-Code:
Sub test()
Dim lLRow%, dDate As Date
lLRow = Cells(Rows.Count, 2).End(xlUp).Row
dDate = CDate(Day(Cells(lLRow, 2)) & "." & Month(Cells(lLRow, 2)) & "." & Year(Cells(lLRow, 2)) + 1)
If Date >= dDate Then Cells(lLRow + 1, 2) = dDate
End Sub 

Guten Morgen!

Danke sehr, funktioniert super. Eine kleine Bitte hätte ich noch. Wie müsste der Code aussehen, wenn ich eine Messagebox haben will, wenn ein neues Datum eingetragen wird? Diese Messagebox soll aber nur dann aufpoppen, wenn ein neues Datum eingetragen wurde, sonst nicht.

Danke und

LG
Thomas

Hallo noch einmal!

Ich glaube, dass ich es schon selbst zusammen gebracht habe, hier mein Code:

Code:
' immmer mit Option explicit arbeiten !

' nicht nur hinschreiben, sondern auch TUN!

'''''''''''''''''''''''''''''''

Option Explicit  '!!!!!!!!!!!!!!!

'''''''''''''''''''''''''''''''

Private Sub Worksheet_Activate()

Dim lLRow%, dDate As Date

lLRow = Cells(Rows.Count, 2).End(xlUp).Row

dDate = CDate(Day(Cells(lLRow, 2)) & "." & Month(Cells(lLRow, 2)) & "." & Year(Cells(lLRow, 2)) + 1)

If Date >= dDate Then

Cells(lLRow + 1, 2) = dDate

MsgBox "neuer Wert eingetragen"

Else

If Date <= dDate Then

End If

End If

End Sub

Seiten: 1 2

dertommy

schauan

dertommy

schauan

dertommy

dertommy

dertommy

schauan

dertommy

dertommy