Hilfe bei VBA Programmierung eines Excel-Makros

[_Sophie_]

Hallo zusammen,

ich versuche mich gerade zum ersten mal an einer Programmierung eines Excel-Makros, habe kaum bis keine Vorkenntnisse von VBA und mein bisheriger Stand des Makros ist auch nur Dank Google und toller Beiträge in verschiedenen Foren. 

In meiner Excel-Datei sind viele Datum-Angaben. Ich will nun gerne ein Makro haben, dass mir in einem Pop-Up Fenster beim Öffnen der Datei die Fälle ausgibt, die "Überfällig" also älter als das aktuelle Datum oder "Bald Fällig" also im nächsten Monat (bzw. heutiges Datum + 30 Tage) sind. Das funktioniert prinzipiell auch schon. Hier ist das aktuelle Makro:

Sub Workbook_Open()
Sheets("Lösch-Kündiger").Activate
  Dim rDatFällig
  Dim sMsgBaldFaellig As String
  Dim sMsgUeberFaellig As String
  sMsgBaldFaellig = ""
  sMsgUeberFaellig = ""
 
  For Each rDatFällig In Range("A4:A90000,G4:G90000,N4:N90000")
    If rDatFällig.Value <> "" Then
      If rDatFällig.Value <= Date Then
        sMsgUeberFaellig = sMsgUeberFaellig & Cells(rDatFällig.Row, 1) & " " & Cells(rDatFällig.Row, 2) & vbCrLf
      Else
        If rDatFällig.Value <= (Date + 30) Then _
          sMsgBaldFaellig = sMsgBaldFaellig & Cells(rDatFällig.Row, 1) & " " & Cells(rDatFällig.Row, 2) & vbCrLf
      End If
    End If
  Next
 
  If sMsgUeberFaellig & sMsgBaldFaellig <> "" Then
    MsgBox "Überfällig" & vbCrLf & sMsgUeberFaellig & "Bald fällig" & vbCrLf & sMsgBaldFaellig
  End If
End Sub

   

Ich hab jetzt nur zwei Probleme:

1. Habe ich drei verschiedene Spalten mit Datum-Angaben, die geprüft werden sollen. Daher ist die Range auch A4:A90000,G4:G90000,N4:N90000. Jedoch werden mir im Pop-Up nur die Fälle angezeigt, die in A4:A90000 stehen. Selbst wenn z.B. in G5 ein Fall ist, der "Bald Fällig" ist, erscheint nicht dieser im Pop-Up, sondern der Fall, der in A5 steht (und auch "Bald fällig" ist), wird zweimal im Pop-Up Fenster aufgelistet.

   

2. Hätte ich gerne, dass mir bei den "Überfälligen" Fällen nur die angezeigt werden, die älter als das heutige Datum sind UND in der Spalte (hier z.B. E, K und R) nichts stehen haben. Könntet ihr mir sagen, wie ich das programmiere?


Vielen Dank und viele Grüße
Sophie

[Der Steuerfuzzi]

Hallo,

leider ist es nicht ganz einfach zu helfen, wenn man die Datei nicht kennt. Aber ich vermute mal, dass der Text immer rechts neben dem Datum steht, so das z. B. diese Zeile zum falschen Ergebnis führt:

Code:

sMsgUeberFaellig = sMsgUeberFaellig & Cells(rDatFällig.Row, 1) & " " & Cells(rDatFällig.Row, 2) & vbCrLf

Hier holst Du immer die Werte aus Spalte 1 und 2, egal, ob das Datum in G oder N gefunden wurde. rDatFaellig ist schon eine Range, diese musst Du nicht mit Cells noch auf sich selbst zeigen lassen, daher reicht für das Datum rDatFällig.Value. Für den Text daneben kann man entweder rDatFällig.Offset(0,1).Value oder bei Deiner Methode Cells(rDatFällig.Row, rDatFällig.Column + 1).

Ich würde nicht nach leeren Zellen abfragen, sondern mit IsDate nach einem gültigen Datum.

Activate ist übrigens immer eher unnötig bis störend. Hier kann man gleich direkt auf das Sheet verweisen, z. B. indem man das Sheets("Lösch-Kündiger") davor setzt:

Code:

Sub Workbook_Open()
'Sheets("Lösch-Kündiger").Activate
  Dim rDatFällig
  Dim sMsgBaldFaellig As String
  Dim sMsgUeberFaellig As String
  sMsgBaldFaellig = ""
  sMsgUeberFaellig = ""

  For Each rDatFällig In Sheets("Lösch-Kündiger").Range("A4:A9,G4:G9,N4:N9")
    If IsDate(rDatFällig.Value) Then
      If rDatFällig.Value <= Date Then
        sMsgUeberFaellig = sMsgUeberFaellig & rDatFällig.Value & " " & Sheets("Lösch-Kündiger").Cells(rDatFällig.Row, rDatFällig.Column + 1) & vbCrLf
      Else
        If rDatFällig.Value <= (Date + 30) Then _
          sMsgBaldFaellig = sMsgBaldFaellig & rDatFällig.Value & " " & Sheets("Lösch-Kündiger").Cells(rDatFällig.Row, rDatFällig.Column + 1) & vbCrLf
      End If
    End If
  Next

  If sMsgUeberFaellig & sMsgBaldFaellig <> "" Then
    MsgBox "Überfällig" & vbCrLf & sMsgUeberFaellig & "Bald fällig" & vbCrLf & sMsgBaldFaellig
  End If
End Sub

Bei so vielen Zellen kann ein direkter Zugriff auf die Zellen dazu führen, dass dein Makro relativ langsam wird. Man könnte die Anzahl der Zellen einschränken, indem man je Spalte die letzte Zeile ermittelt. Wenn das immer noch zu langsam ist, könnte man die Daten in eine Variable schreiben und im Speicher abarbeiten.