Messagebox und Abbruch, falls Datum nicht vorhande
17.10.2005 12:08:20
Daniel
vor einiger Zeit hat mir ein user hier im Forum ein Makro geschrieben.
Nun möchte ich dieses gerne ergänzen, nur leider kenne ich mich nach wie vor in VBA kaum aus. Ich hoffe mir kann nochmal jemand helfen.
In dem Makro werden Summen über mehrere Blättr für bestimmte Tage berechnet.
Wenn nun aber in einem der Blätter (Blatt1, Blatt2, Blatt3) jeweils in Spalte A, das Datum das in Gesamtauswertung B8 steht, nicht vorhanden ist, dann soll
- eine Messagebox mit Warnhinweis kommmen und
- aus dem Makro ausgestiegen werden.
Wie kann ich das einfügen?
Für Hilfe wäre ich euch sehr dankbar.
Grüße,
Daniel
Hier noch das Makro:
'Prozedur Blattsumme:
'Argumente: dat nach diesem Datum wird gesucht
' Spalte: Addiert die Werte der Blätter in dieser Spalte
' Ergebnisspalte: in diese Spalte wird die Summe geschrieben
Sub Blattsumme(dat As Date, Spalte As Integer, Ergebnisspalte As Integer)
Dim Blatt()
Dim Summe As Double
Dim bl
Dim z As Range
'Blattnamen (kann erweitert werden):
Blatt = Array("Blatt1", "Blatt2", "Blatt3")
'Spalte A aller Blätter durchsuchen und in [Spalte] liegende Werte addieren
For Each bl In Blatt
Debug.Print bl
Set z = ThisWorkbook.Sheets(bl).Range("A:A").Find(What:=dat)
If Not z Is Nothing Then Summe = Summe + z.Offset(0, Spalte - 1).Value
Next bl
'Summe in Tabelle eintragen:
Dim lz As Long
With ThisWorkbook.Sheets("Gesamtauswertung")
'Suche Datum in Spalte A von Gesamtauswertung
Set z = .Range("A:A").Find(What:=dat)
If z Is Nothing Then
'nicht gefunden, dann neue Zeile anlegen
lz = .Cells(Rows.Count, Ergebnisspalte).End(xlUp).Row + 1
.Cells(lz, 1) = dat
Else
'gefunden, dann diese Zeile verwenden
lz = z.Row
End If
.Cells(lz, Ergebnisspalte) = Summe
.Cells(lz, Ergebnisspalte) = Summe
If Ergebnisspalte = 5 Then .Range("B3") = Summe
If Ergebnisspalte = 9 Then .Range("B4") = Summe
End With
End Sub
'---------------------------------------------------------------
'Test: Summiert die Treffen der Spalten B-K, ohne F und G
Sub Summen()
Dim i As Integer
For i = 2 To 5 'Spalte B-E
Blattsumme ThisWorkbook.Sheets("Gesamtauswertung").Range("B8"), i, i
Next i
For i = 8 To 11 'Spalte H-K
Blattsumme ThisWorkbook.Sheets("Gesamtauswertung").Range("B8"), i, i
Next i
End Sub