Datum nicht heute, sondern Auswahlfeld
22.09.2005 17:04:13
Daniel
mir wurde hier im Forum vor einiger Zeit ein Makro geschrieben. Leider weiß ich selbst nicht, wie ich das meinen neuen Bedürfnissen anpassen kann.
Vielleicht kann mir ja jemand helfen.
Das Makro sucht bisher in verschiedenen Blättern nach den Zeilen, bei denen das heutige Datum steht und führt dann mit den Zellen dieser Zeilen Berechnungen durch. Im Anschluß wird das Ergebnis in die nächste Zeile geschrieben, wenn das Datum im Sheet Gesamtauswertung nicht schon vorhanden ist.
Nun möchte ich das aber auch für vergangene Daten machen. Hier müssen die Ergebniss natürlich in den bereits vorhanden Zellen in Gesamtauswertung überschrieben werden. Das Datum selbst, nach dem gesucht werden soll, steht jetzt in B6 im Sheet Gesamtauswertung.
So, ich hoffe ich konnte mein Problem verständlich darlegen.
Hier noch das Makro:
'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("Hüffer", "Albrecht", "Posmik", "Schuback")
'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
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 Date, i, i
Next i
For i = 8 To 11 'Spalte H-K
Blattsumme Date, i, i
Next i
End Sub