Werte aus letzter beschriebener Zeile ermitteln und in Messagebox ausgeben
#1
Hallo!

Ich möchte in einer Messagebox alle Werte ausgeben, die in der letzten beschriebenen Zeile vorhanden sind. In meinem Fall stehen in den Spalten A, B, C, E, F, H, I, K und L Werte.

Anbei  mein aktueller Code in diesem Arbeitsblatt:


Code:
'''''''''''''''''''''''''''''''
Option Explicit  '!!!!!!!!!!!!!!!
'''''''''''''''''''''''''''''''

Private Sub Worksheet_Activate()

Dim lr As Long
Dim i As Long
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, 2).Value = Worksheets("Comgest Growth Greater China").Range("H5").Value
   Me.Cells(lr, 3).Value = Worksheets("Comgest Growth Greater China").Range("H6").Value
   Me.Cells(lr, 5).Value = Worksheets("DWS Deutschland").Range("H5").Value
   Me.Cells(lr, 6).Value = Worksheets("DWS Deutschland").Range("H6").Value
   Me.Cells(lr, 8).Value = Worksheets("Flossbach von Storch").Range("H5").Value
   Me.Cells(lr, 9).Value = Worksheets("Flossbach von Storch").Range("H6").Value
   Me.Cells(lr, 11).Value = Worksheets("Flossbach von Storch").Range("N8").Value
   Me.Cells(lr, 12).Value = Worksheets("Flossbach von Storch").Range("P8").Value
   MsgBox "Die Kursentwicklungsdaten wurden aktualisiert."
 Next i

End If
   
aufräumen:

With Application
 .ScreenUpdating = True
 .EnableEvents = True
End With

With Worksheets("Kursentwicklung")
 .Activate
 .Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
End With

End Sub

Ich hoffe, dass mir jemand helfen kann.

LG
Excel Version 2016
Top
#2
Hat sich schon erübrigt, habs selbst zusammengebracht.
Excel Version 2016
Top
#3
Moin

und wenn nu einer mit der gleichen Problemstellung
über die Suchmaschine seines Vertrauens auf diesen Thread stößt
wird er mit deiner angegebenen Lösung wohl kaum etwas anfangen können

MfG Tom
Top
#4
Hallo!

Tut mir leid, da hast du natürlich recht. Hier ein Auszug aus dem Code:
Code:
MsgBox "Die Kursentwicklungsdaten wurden per " & Me.Cells(lr, 1) & " aktualisiert. " & String(1, vbNewLine) & _
Excel Version 2016
Top
#5
Hallo,

Zitat:Tut mir leid, da hast du natürlich recht. Hier ein Auszug aus dem Code:
Code:
Code:
MsgBox "Die Kursentwicklungsdaten wurden per " & Me.Cells(lr, 1) & " aktualisiert. " & String(1, vbNewLine) & _


.... findest Du nicht auch, daß da Einiges fehlten könnte, damit ein Suchender auch wirklich zu einer Lösung für das Problem kommen kann?
Geh' mal tief in Dich und überlege mal, was da wohl fehlen könnte.
Top
#6
Hier mein gesamter fertiger 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 DifferenzletzteAktualisierungalle3FondsmitStichtag As String
Dim DifferenzletzteAktualisierungalle3FondsseitAbschluss 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, 2).Value = Worksheets("Comgest Growth Greater China").Range("H5").Value
   Me.Cells(lr, 3).Value = Worksheets("Comgest Growth Greater China").Range("H6").Value
   Me.Cells(lr, 5).Value = Worksheets("DWS Deutschland").Range("H5").Value
   Me.Cells(lr, 6).Value = Worksheets("DWS Deutschland").Range("H6").Value
   Me.Cells(lr, 8).Value = Worksheets("Flossbach von Storch").Range("H5").Value
   Me.Cells(lr, 9).Value = Worksheets("Flossbach von Storch").Range("H6").Value
   Me.Cells(lr, 11).Value = Worksheets("Flossbach von Storch").Range("N8").Value
   Me.Cells(lr, 12).Value = Worksheets("Flossbach von Storch").Range("P8").Value
   With Worksheets("Kursentwicklung")
       .Range("B2").Value = Me.Cells(lr, 2) - Me.Cells(lr - 1, 2)
       DifferenzletzteAktualisierungFonds1mitStichtag = .Range("B4").Value
       .Range("C2").Value = Me.Cells(lr, 3) - Me.Cells(lr - 1, 3)
       DifferenzletzteAktualisierungFonds1seitAbschluss = .Range("C4").Value
       .Range("E2").Value = Me.Cells(lr, 5) - Me.Cells(lr - 1, 5)
       DifferenzletzteAktualisierungFonds2mitStichtag = .Range("E4").Value
       .Range("F2").Value = Me.Cells(lr, 6) - Me.Cells(lr - 1, 6)
       DifferenzletzteAktualisierungFonds2seitAbschluss = .Range("F4").Value
       .Range("H2").Value = Me.Cells(lr, 8) - Me.Cells(lr - 1, 8)
       DifferenzletzteAktualisierungFonds3mitStichtag = .Range("H4").Value
       .Range("I2").Value = Me.Cells(lr, 9) - Me.Cells(lr - 1, 9)
       DifferenzletzteAktualisierungFonds3seitAbschluss = .Range("I4").Value
       .Range("K2").Value = Me.Cells(lr, 11) - Me.Cells(lr - 1, 11)
       DifferenzletzteAktualisierungalle3FondsmitStichtag = .Range("K4").Value
       .Range("L2").Value = Me.Cells(lr, 12) - Me.Cells(lr - 1, 12)
       DifferenzletzteAktualisierungalle3FondsseitAbschluss = .Range("L4").Value
   End With
   MsgBox "Die Kursentwicklungsdaten 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, 2), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungFonds1mitStichtag & " %)" & String(1, vbNewLine) & _
   "Prozentsatz seit Abschluss: " & Format(Me.Cells(lr, 3), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungFonds1seitAbschluss & " %)" & String(2, vbNewLine) & _
   "DWS Deutschland:" & String(1, vbNewLine) & _
   "-------------------" & String(2, vbNewLine) & _
   "Prozentsatz mit Stichtag: " & Format(Me.Cells(lr, 5), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungFonds2mitStichtag & " %)" & String(1, vbNewLine) & _
   "Prozentsatz seit Abschluss: " & Format(Me.Cells(lr, 6), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungFonds2seitAbschluss & " %)" & String(2, vbNewLine) & _
   "Flossbach von Storch:" & String(1, vbNewLine) & _
   "----------------------" & String(2, vbNewLine) & _
   "Prozentsatz mit Stichtag: " & Format(Me.Cells(lr, 8), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungFonds3mitStichtag & " %)" & String(1, vbNewLine) & _
   "Prozentsatz seit Abschluss: " & Format(Me.Cells(lr, 9), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungFonds3seitAbschluss & " %)" & String(2, vbNewLine) & _
   "alle 3 Fonds:" & String(1, vbNewLine) & _
   "-------------" & String(2, vbNewLine) & _
   "Prozentsatz mit Stichtag: " & Format(Me.Cells(lr, 11), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungalle3FondsmitStichtag & " %)" & String(1, vbNewLine) & _
   "Prozentsatz seit Abschluss: " & Format(Me.Cells(lr, 12), "#,##0.00") & " %  (" & DifferenzletzteAktualisierungalle3FondsseitAbschluss & " %)" & String(2, vbNewLine)
 Next i

End If
   
aufräumen:

With Application
 .ScreenUpdating = True
 .EnableEvents = True
End With

With Worksheets("Kursentwicklung")
 .Activate
 .Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
End With

End Sub
Excel Version 2016
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste