MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Access & Datenbanken > Microsoft Access - Code Archiv
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 17.02.2004, 16:34   #1
TommyK
MOF Meister
MOF Meister
Standard Codebeispiel - Abfrage von Zeiträumen

Hallo,

Problemstellung:
Heute möchte ich mich mit der Errechnung von Zeiträumen als Abfragekriterium beschäftigen.
Fast jeder hat schon vor der Aufgabe gestanden, ich brauche die Daten des letzten Quartals oder die Termine der nächste Woche.
Um jetzt zu den benötigten Datumsangaben zu kommen nehme ich meinen Tischkalender oder fange an mir selbst etwas zu schreiben usw.
Und wie es dann in der Praxis aus, entweder man bekommt zwei Inputboxen vorgesetzt „Bitte geben Sie das Startdatum ein:“.... Äh, nächste Woche erster Tag, wo ist der blöde Kalender?
Schöner wäre es man könnte Access sagen, Ich will die Daten „der nächsten Woche“. Aber leider tut sich Access damit schwer oder will mich nicht verstehen.
Um dies aber doch zutun habe ich mal ein Funktion geschrieben, die diese Begriffe „der nächsten Woche“ usw., übersetzt.
Das Ganze ist beliebig erweiterbar (s. weiter unten)
Das im Bsp. Enthaltene UFO ist nur aus Demozwecken enthalten und wird nicht zum Betrieb der Funktion benötigt.

Voraussetzungen:

Das Bsp ist unter A97, A00 und AXP lauffähig, unter A03 wurde es nicht getestet.


Funktionsweise:

Hier die eigentlichen Funktion:

Code:

Public Function CalcDate(dateDatum As Date, intValue As Integer, intFirstLast As Integer, strArt As String) As Date
'*******************************************
'Name:      CalcDate (Function)
'Purpose:   Ermittelt verschiedene Datumsangaben aus den Bereichen Tag, Woche, Monat, Quartal, Halbjahr und Jahr
'Author:    Thomas Keßler
'Date:      Februar 12, 2004, 11:45:00
'Inputs:    dateDatum= Datum ab dem gerechnet werden soll, intValue= Berechnungswert +/- vom dateDatum
'           intFirstLast= Berechnung des ersten oder letzten Datums des gewählten Zeitraumes (-1=Beginn, 0=Ende)
'           strArt= Art des Datums ( D=Tag, W=Woche, M= Monat, Q= Quartal, H= Halbjahr und J=Jahr
'Output:    Datum
'Example:   X=CalcDate(Date,-1,-1,M) würde den ersten Tag des letzten Monats ausgehend vom heutigen ermitteln
'*******************************************
On Error GoTo Err_Date
 
    Dim varQ_First As Variant, varQ_Last As Variant
    Dim varHbj_First As Variant, varHbj_Last As Variant
    Dim varFirstDayWeek As Variant
    Dim dateLastDayMonth As Date
    Dim intMonth As Integer, intYear As Integer
 
    ' Wenn falsche Parameter dann raus hier
    If Not IsDate(dateDatum) Then dateDatum = Date
    If intFirstLast > 0 Or intFirstLast < -1 Then GoTo Err_Date_Exit
 
    ' erster Tag der aktuellen Woche
    varFirstDayWeek = FirstDayWeek(dateDatum)
    ' erster Tag des aktuellen Quartals
    varQ_First = FirstDayQuartal(dateDatum)
    ' letzter Tag es aktuellen Quartals
    varQ_Last = LastDayQuartal(dateDatum)
    ' erster Tag des aktuellen Halbjahres
    varHbj_First = FirstDayHalfYear(dateDatum)
    ' letzter Tag des aktuellen Halbjahres
    varHbj_Last = LastDayHalfYear(dateDatum)
 
    ' Startdatum des gewählten Zeitraumes
    If intFirstLast = -1 Then
    ' Auswahl des Typs
        Select Case strArt
            Case Is = "D"
                'Tage
                CalcDate = dateDatum + intValue
            Case Is = "W"
                ' Wochen
                CalcDate = varFirstDayWeek + intValue
            Case Is = "M"
                ' Monate
                intMonth = Month(dateDatum)
                CalcDate = DateSerial(Year(dateDatum), intMonth + intValue, 1)
            Case Is = "Q"
                ' Quartale
                intYear = Format(DateAdd("m", intValue, varQ_First), "yyyy")
                intMonth = Format(DateAdd("m", intValue, varQ_First), "mm")
                CalcDate = DateSerial(intYear, intMonth, 1)
            Case Is = "H"
                ' Halbjahre
                intYear = Format(DateAdd("m", intValue, varHbj_First), "yyyy")
                intMonth = Format(DateAdd("m", intValue, varHbj_First), "mm")
                CalcDate = DateSerial(intYear, intMonth, 1)
            Case Is = "J"
                ' Jahre
                intYear = Year(dateDatum)
                CalcDate = DateSerial(intYear + intValue, 1, 1)
            Case Else
                ' ungültiger Wert
                GoTo Err_Date_Exit
        End Select
    ' Enddatum des gewählten Zeitraumes
    Else
    ' Auswahl des Typs
        Select Case strArt
            Case Is = "D"
                'Tage
                CalcDate = dateDatum + intValue
            Case Is = "W"
                ' Wochen
                CalcDate = varFirstDayWeek + intValue
            Case Is = "M"
                ' Monate
                intMonth = Month(dateDatum)
                dateLastDayMonth = DateSerial(Year(dateDatum), intMonth + intValue, 1)
                CalcDate = LastDayMonth(dateLastDayMonth)
            Case Is = "Q"
                ' Quartale
                intYear = Format(DateAdd("m", intValue, varQ_Last), "yyyy")
                intMonth = Format(DateAdd("m", intValue, varQ_Last), "mm")
                dateLastDayMonth = DateSerial(intYear, intMonth, 1)
                CalcDate = LastDayMonth(dateLastDayMonth)
            Case Is = "H"
                ' Halbjahre
                intYear = Format(DateAdd("m", intValue, varHbj_Last), "yyyy")
                intMonth = Format(DateAdd("m", intValue, varHbj_Last), "mm")
                dateLastDayMonth = DateSerial(intYear, intMonth, 1)
                CalcDate = LastDayMonth(dateLastDayMonth)
            Case Is = "J"
                ' Jahre
                intYear = Year(dateDatum)
                CalcDate = DateSerial(intYear + intValue, 12, 31)
            Case Else
                ' ungültiger Wert
                GoTo Err_Date_Exit
        End Select
    End If
 
Err_Date_Exit:
    Exit Function
Err_Date:
    Dim strErrString As String
    strErrString = "Error Information..." & vbCrLf
    strErrString = strErrString & "Error#: " & Err.Number & vbCrLf
    strErrString = strErrString & " Description: " & Err.Description & vbCrLf
    MsgBox strErrString, vbCritical + vbOKOnly, "Error in Function: CalcDate"
    Resume Err_Date_Exit
End Function
 
Code eingefügt mit dem MOF Code Converter


Weiterhin sind einige Hilfsfunktionen im Modul enthalten die CalcDate benötigt:

Code:

    ' erster Tag der aktuellen Woche
    varFirstDayWeek = FirstDayWeek(dateDatum)
    ' erster Tag des aktuellen Quartals
    varQ_First = FirstDayQuartal(dateDatum)
    ' letzter Tag es aktuellen Quartals
    varQ_Last = LastDayQuartal(dateDatum)
    ' erster Tag des aktuellen Halbjahres
    varHbj_First = FirstDayHalfYear(dateDatum)
    ' letzter Tag des aktuellen Halbjahres
    varHbj_Last = LastDayHalfYear(dateDatum)
 
Code eingefügt mit dem MOF Code Converter

Die Funktion "CalcDate" ermittelt dann das Start- bzw. Enddatum
des gewählten Zeitraumes.

Syntax und Argumente:

CalcDate(dateDatum As Date, intValue As Integer, intFirstLast As Integer, strArt As String)

dateDatum = ein beliebiges gültiges Datum das als Bezugsdatum für die Funktion gilt
intValue = Berechnungsfaktor, ist in der Tabelle "tbl_Zeitraeume" hinterlegt (Start oder Ende)
intFirstLast = bei Wert -1 wird das Startdatum des gewählten Zeitraumes berechnet und bei 0 das Enddatum
strArt = Art des Zeitraumes, ist in der Tabelle "tbl_Zeitraeume" hinterlegt

Es gibt jetzt 2 Möglichkeiten das Bsp in der Praxis zu benutzen:

1. Möglichkeit:
Will man das Ganze, visuell (per Auswahl Kombifeld), in der Praxis zu nutzen muss man nur die Tabelle "tbl_Zeitraeume" und das Modul "mod_BerechnungenDatum" in seine DB kopieren.
Eine Kombifeld erstellen und den Zeitraum auswählen.
Der Funktion "CalcDate" werden dann die Spalten des Kombifeldes übergeben.
z.B.: für das Startdatum und das Enddatum (als Bezugsdatum wird hier das heutige Datum, Funktion Date(), genommen:
Me.txt_S = CalcDate(Date, Me.cmb_Zeit.Column(2), -1, Me.cmb_Zeit.Column(4))
Me.txt_E = CalcDate(varDate, Me.cmb_Zeit.Column(3), 0, Me.cmb_Zeit.Column(4))

Der Aufruf in der jeweiligen Abfrage wäre dann als Kriterium:

Code:

Zwischen [Formulare]![frm_Start]![txt_S] Und [Formulare]![frm_Start]![txt_E]
Code eingefügt mit dem MOF Code Converter

Aufbau der Tabelle „tbl_Zeiträume“:

lfd_Nr als Primärfeld. = Nummernkreis der Zeiträume
Folgende Nummernkreise sind vorgegeben, können aber beliebig verändert werden.
10-99 Tage , 100-999 Wochen , 1000-1999 Monate , 2000-2999 Quartale, 3000-3999 Halbjahre , 4000-4999 Jahre

Zeitraum = eine beliebige Bezeichnung die Zeitraum beschreibt
Start = Bezugswert für das Startdatum zum Referenzdatum
Ende = Bezugswert für das Enddatum zum Referenzdatum
Kurz = Kurzbezeichnung für die Art des Zeitraumes, definiert den Bezugsfaktor
D = Tage für Tagesberechnungen
W= Tage für Wochenberechnungen
M = Monate für Monatsberechnungen
Q = Monate für Quartalsberechnungen
H = Monate für Halbjahresberechnungen
J = Jahre für Jahresberechnungen
Einheit = definiert die Einheit für die Felder Start und Ende (nur informativ)

Will man einen Zeitraum in die Tabelle neu eingegeben werden, sind folgende Werte zu setzten:

Lfd_Nr: z.B. 1021 (für den Nummernkreis Monate)
Start: -4
Ende: -1
Kurz: M (für Monatsberechnung)
Einheit: Monate

2. Möglichkeit:
Die Funktion "CalcDate" direkt der Abfrage als Kriterium übergeben.
z.B. die letzen 4 Monate, Referenz Datum Heute:

Code:

Zwischen CalcDate(Datum();-4;-1;"M") Und CalcDate(Datum();-1;0;"M")
Code eingefügt mit dem MOF Code Converter

Es besteht aber die Möglichkeit das Referenzdatum beliebig festzulegen.


Hier gehts zum Download: Auswahl von Zeiträumen

__________________

Gruss TommyK

TKSoft-Online | Beispiele im MOF Code-Archiv
Meine Software:Windows 10 Pro 64Bit, Windows 7 Ultimate 64Bit, Office 2007 Pro SP2, Office 2010 Pro, Office 2013 Pro, Office 2016 Pro, Office 2019 Pro, VB6 Pro SP6, VS2017
TommyK ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 18:34 Uhr.



Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.