Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
560to564
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
560to564
560to564
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Ereignisprozedur bei Monatswechsel

Ereignisprozedur bei Monatswechsel
04.02.2005 20:31:30
Korl
Hallo,
in meinem Tabellenblatt "Stamm" habe ich für die Zelle "F3" eine Gültigkeit für eine Liste festgelegt mit der Anzeige für Monat mit Jahr.
Ist es nun möglich eine Ereignisprozedur anzulegen, die folgendes ausführen soll.
Bei Wechsel des Monats, soll in der Tabelle "Stamm", im Bereich "B7:C140", der Inhalt entfernt werden.
Und, in der Tabelle "Liste", im Bereich "A3:G160", Alles entfernt werden.
Ich habe leider nicht so die Ahnung mit VBA, kann da jemand helfen?
Gruß Korl

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ereignisprozedur bei Monatswechsel
04.02.2005 20:51:14
Josef
Hallo Korl!
Kleine Vorarbeit!
Gehe auf "Einfügen" &gt "Namen" &gt "Definieren".
Schreib unter "Namen in der Arbeitsmappe" "oldDat", und unter
"Bezieht sich auf" =38387 ! (Ist heute)
Dann füge diesen Code in "DieseArbeitsmappe"

Private Sub Workbook_Open()
If Month(Right(ThisWorkbook.Names("oldDat").Value, 5)) < Month(Date) Then
Sheets("Stamm").Range("B7:C140").ClearContents
Sheets("Liste").Range("A3:G160").Clear
ThisWorkbook.Names("oldDat").Value = CDbl(Date)
End If
End Sub

Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
Anzeige
AW: Ereignisprozedur bei Monatswechsel
04.02.2005 21:21:32
Korl
Hallo Sepp,
Schön, das Du mir mal wieder unter die Arme greifst.
Ich habe den Namen "oldDat" "=38387" vergeben und den Code dort hingesetzt wo er hin soll. Anschließend das File gespeichert, geschlossen und neu aufgerufen, aber nichts,
alles ruht.
Frage: Bindest Du das aktuelle Datum "heute()" in den Code ein?
Eigentlich möchte ich nur wenn in der Tabelle "Stamm" Zelle "F3" der Monat gewechselt wird. Also, immer wenn ein anderer Inahlt in der Zelle steht als vorher.
Lässt sich dieses so einrichten?
Gruß Korl
AW: Ereignisprozedur bei Monatswechsel
04.02.2005 21:52:12
Josef
Hallo Korl!
Da hab ich die Frage falsch interpretiert!
Ich dachte bei einem "wirklichen" Monatswechsel!

'Allgemeines Modul
Dim oldVal As Variant
'DieseArbeitsmappe
Private Sub Workbook_Open()
oldVal = Sheets("Stamm").Range("F3")
End Sub
'Tabelle "Stamm"
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$3" Then
On Error GoTo errorhandler
If Target <> oldVal Then
Application.EnableEvents = False
Range("B7:C140").ClearContents
Sheets("Liste").Range("A3:G160").Clear
oldVal = Target
End If
End If
errorhandler:
Application.EnableEvents = True
End Sub

Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
Anzeige
AW: Ereignisprozedur bei Monatswechsel
04.02.2005 22:16:38
Korl
Hallo Sepp,
entschuldige bitte wenn ich mich etwas unklar ausgedrückt hatte.
Jetzt wird es aber mit meinen Ereignissprozeduren in der Tabelle "Stamm" etwas eng!
Dort habe ich nun zwei "

Private Sub Worksheet_Change(ByVal Target As Range)" stehen.
Für die Datumeingabe ohne Punkt:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim Datum As String
Dim Tar2 As String
Dim j As String, m As String, t As String
Set Bereich = Range("B7", "B132")
If Not Intersect(Target, Bereich) Is Nothing Then
Application.EnableEvents = False
On Error GoTo err
Tar2 = CStr(CLng(Target.Value))
If Len(Tar2) = 6 Or Len(Tar2) = 5 Then ' neu: Or Len(Tar2) = 5
' neu
If Len(Tar2) = 6 Then
t = Left(Tar2, 2)
Else
t = "0" & Left(Tar2, 1)
End If
' neu
If Len(Tar2) = 6 Then
m = Mid(Tar2, 3, 2)
Else
m = Mid(Tar2, 2, 2)
End If
j = Right(Tar2, 2)
If Val(j) > 30 Then
j = "19" & j
Else
j = "20" & j
End If
Datum = t & "." & m & "." & j
If IsDate(Datum) Then
' neu
Target = CDate(Datum)
Target.NumberFormat = "dd.mm.yyyy"
Else
Target = ""
Target.Activate
End If
Else ' neu
Target.ClearContents ' neu
End If
Application.EnableEvents = True
On Error GoTo 0
End If
Exit Sub
err:
Application.EnableEvents = True
End Sub

und jetzt Deine:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$3" Then
On Error GoTo errorhandler
If Target <> oldVal Then
Application.EnableEvents = False
Range("B7:C140").ClearContents
Sheets("Liste").Range("A3:G160").Clear
oldVal = Target
End If
End If
errorhandler:
Application.EnableEvents = True
End Sub

Lassen sich diese beiden Ereignissprozeduren irgenwie zusammen schrauben?
Bei einfachen Subprozeduren kann ich mir manchmal etwas anpassen aber Ereignissprozeduren, oh man, oh man!
Gruß Korl
Anzeige
AW: Ereignisprozedur bei Monatswechsel
04.02.2005 22:24:15
Josef
Hallo Korl!
Kein Problem!
Das "Exit Sub" war in deinem Code fehl am Platz!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim Datum As String
Dim Tar2 As String
Dim j As String, m As String, t As String
On Error GoTo err
Set Bereich = Range("B7", "B132")
If Not Intersect(Target, Bereich) Is Nothing Then
Application.EnableEvents = False
Tar2 = CStr(CLng(Target.Value))
If Len(Tar2) = 6 Or Len(Tar2) = 5 Then ' neu: Or Len(Tar2) = 5
' neu
If Len(Tar2) = 6 Then
t = Left(Tar2, 2)
Else
t = "0" & Left(Tar2, 1)
End If
' neu
If Len(Tar2) = 6 Then
m = Mid(Tar2, 3, 2)
Else
m = Mid(Tar2, 2, 2)
End If
j = Right(Tar2, 2)
If Val(j) > 30 Then
j = "19" & j
Else
j = "20" & j
End If
Datum = t & "." & m & "." & j
If IsDate(Datum) Then
' neu
Target = CDate(Datum)
Target.NumberFormat = "dd.mm.yyyy"
Else
Target = ""
Target.Activate
End If
Else ' neu
Target.ClearContents ' neu
End If
Application.EnableEvents = True
On Error GoTo 0
End If
If Target.Address = "$F$3" Then
If Target <> oldVal Then
Application.EnableEvents = False
Range("B7:C140").ClearContents
Sheets("Liste").Range("A3:G160").Clear
oldVal = Target
End If
End If
err:
Application.EnableEvents = True
End Sub

Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
Anzeige
Danke, Sepp, klappt prima!!
04.02.2005 22:37:49
Korl
Hallo Sepp,
es läuft tadellos und sogar nach meinen Vorstellungen!
Hab Dank dafür!!!
Gruß Korl

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige