Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Mehrfache Wahrscheinlichkeit

Betrifft: Mehrfache Wahrscheinlichkeit
von: Marc Voelker
Geschrieben am: 15.04.2003 - 16:36:12

Abend.
Ich glaub es wird zeit, das ich endlich urlaub hab. steh momentan voll aufem schlauch.

Ich habe ne liste an Datumsvariablen.
diese möchte ich jeweils mit nem ausgewählten datum abgleichen.
wenn das gewählte datum einem aus der liste entspricht, soll die spalte grau werden...
soweit so gut...
Das Datum auswählen klappt.
Wie verkürze/-einfach ich den abgleich mit den 16 Daten?



Sub Feiertage()

'  am 2003-04-15 von Marc Voelker aufgezeichnet

    Dim As Single
    Dim OS As Date, OM As Date, CH As Date, PS As Date, PM As Date, FL As Date, KF As Date
    Dim NJ As Date, AH As Date, TdE As Date, TdA As Date, MH As Date, HDK As Date, HA As Date, HA1 As Date, HA2 As Date
    Dim As Long, b As Long, c As Long
        
    OS = CDate("1 / 1 / 1")
    
    ' Ostern berechnen - geht, aber k.a. wie...
    If (((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) + ((32 + 2 * ((Year(Now()) \ 100) Mod 4) + 2 * (((Year(Now())) Mod 100) \ 4) - ((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) - ((Year(Now())) Mod 100) Mod 4) Mod 7) - 7 * ((((Year(Now())) Mod 19) + 11 * ((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) + 22 * ((32 + 2 * ((Year(Now()) \ 100) Mod 4) + 2 * (((Year(Now())) Mod 100) \ 4) - ((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 
100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) - ((Year(Now())) Mod 100) Mod 4) Mod 7)) \ 451) + 22) - 31 < 1 Then
       x = ((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) + ((32 + 2 * ((Year(Now()) \ 100) Mod 4) + 2 * (((Year(Now())) Mod 100) \ 4) - ((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) - ((Year(Now())) Mod 100) Mod 4) Mod 7) - 7 * ((((Year(Now())) Mod 19) + 11 * ((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) + 22 * ((32 + 2 * ((Year(Now()) \ 100) Mod 4) + 2 * (((Year(Now())) Mod 100) \ 4) - ((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 
100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) - ((Year(Now())) Mod 100) Mod 4) Mod 7)) \ 451) + 22
    Else
       x = (((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) + ((32 + 2 * ((Year(Now()) \ 100) Mod 4) + 2 * (((Year(Now())) Mod 100) \ 4) - ((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) - ((Year(Now())) Mod 100) Mod 4) Mod 7) - 7 * ((((Year(Now())) Mod 19) + 11 * ((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) + 22 * ((32 + 2 * ((Year(Now()) \ 100) Mod 4) + 2 * (((Year(Now())) Mod 100) \ 4) - ((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 
100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) - ((Year(Now())) Mod 100) Mod 4) Mod 7)) \ 451) + 22) - 31
    End If
    
    
    If (((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) + ((32 + 2 * ((Year(Now()) \ 100) Mod 4) + 2 * (((Year(Now())) Mod 100) \ 4) - ((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) - ((Year(Now())) Mod 100) Mod 4) Mod 7) - 7 * ((((Year(Now())) Mod 19) + 11 * ((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) + 22 * ((32 + 2 * ((Year(Now()) \ 100) Mod 4) + 2 * (((Year(Now())) Mod 100) \ 4) - ((19 * ((Year(Now())) Mod 19) + (Year(Now()) \ 100) - ((Year(Now()) \ 100) \ 4) - ((Year(Now()) \ 
100) - (((Year(Now()) \ 100) + 8) \ 25) + 1) \ 3 + 15) Mod 30) - ((Year(Now())) Mod 100) Mod 4) Mod 7)) \ 451) + 22) > 31 Then
'      MsgBox DateSerial(Year(Date), 4, x)
       OS = DateSerial(Year(Date), 4, x)
    Else
'      MsgBox DateSerial(Year(Date), 3, x)
       OS = DateSerial(Year(Date), 3, x)

    End If
    
    
    'Osternabhängige Feiertage
    KF = OS - 2
    OM = OS + 1
    CH = OS + 39
    PS = OS + 49
    PM = OS + 50
    FL = OS + 60
        
    'fixe Feiertage
    NJ = DateSerial(Year(Date), 1, 1)
    AH = DateSerial(Year(Date), 11, 1)
    TdE = DateSerial(Year(Date), 10, 3)
    TdA = DateSerial(Year(Date), 5, 1)
    MH = DateSerial(Year(Date), 8, 15)
    HDK = DateSerial(Year(Date), 1, 6)
    HA = DateSerial(Year(Date), 12, 24)
    HA1 = DateSerial(Year(Date), 12, 25)
    HA2 = DateSerial(Year(Date), 12, 26)


Sheets("Zeitplan").Select

'Auslesen der letzten Spalte
c = Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).column
c = c - 1

    
    For b = 8 To c
    
        If Cells(1, b) = OM Then
                'markiert die Zelle grau
                Columns(b).Interior.ColorIndex = 15
                            
        End If
    Next


End Sub


     Code eingefügt mit
Syntaxhighlighter 2.0

Gruß+Dank
der, der aufem schlauch steht

  

Wizig
von: moe
Geschrieben am: 15.04.2003 - 16:57:07

Hallo der aufem schlauch steht

es ist bestimmt nicht schwer aber anstatt den ganzen Code zu posten sag doch einfach wie die variablen heissen und der Range der eingefärbt werden soll.
das spart uns allen zeit

gruss
der keinen Bock hat tausen zeilen zu lesen

Es handelt sich um die Gaussische Osterformel oder ??
zu berechnung der feiertage

  

Re: Mehrfache Wahrscheinlichkeit
von: Ramses
Geschrieben am: 15.04.2003 - 17:03:09

Hallo Mark,

ich weiss nicht, was du mit den "16 Daten abgleichen meinst".
Aber zur Vereinfachung dieses Monsters hätte ich was :-)


Function Feiertag(Datum As Date) As String
    Dim j%, D%
    Dim O As Date
    j = Year(Datum)
    'Osterberechnung
    D = (((255 - 11 * (j Mod 19)) - 21) Mod 30) + 21
    O = DateSerial(j, 3, 1) + D + (D > 48) + 6 - _
    ((j + j \ 4 + D + (D > 48) + 1) Mod 7)
    'Hier ist die osterberechnung eigentlich zu Ende :-))
    'O = Das Osterdatum
    'Feiertage berechnen
    Select Case Datum
        Case Is = DateSerial(j, 1, 1)
            Feiertag = "Neujahr"
        Case Is = DateSerial(j, 1, 6)
            Feiertag = "Dreikönig*"
        Case Is = DateAdd("D", -2, O)
            Feiertag = "Karfreitag"
        Case Is = O
            Feiertag = "Ostersonntag"
        Case Is = DateAdd("D", 1, O)
            Feiertag = "Ostermontag"
        Case Is = DateSerial(j, 5, 1)
            Feiertag = "Erster Mai"
        Case Is = DateAdd("D", 39, O)
            Feiertag = "Christi Himmelfahrt"
        Case Is = DateAdd("D", 49, O)
            Feiertag = "Pfingstsonntag"
        Case Is = DateAdd("D", 50, O)
            Feiertag = "Pfingstmontag"
        Case Is = DateAdd("D", 60, O)
            Feiertag = "Fronleichnam*"
        Case Is = DateSerial(j, 8, 15)
            Feiertag = "Maria Himmelfahrt*"
        Case Is = DateSerial(j, 10, 3)
            Feiertag = "Deutsche Einheit"
        Case Is = DateSerial(j, 11, 22) - (DateSerial(j, 11, 18) Mod 7)
            Feiertag = "Buß- und Bettag*"
        Case Is = DateSerial(j, 10, 31)
            Feiertag = "Reformationstag*"
        Case Is = DateSerial(j, 11, 1)
            Feiertag = "Allerheiligen*"
        Case Is = DateSerial(j, 12, 24)
            Feiertag = "Heilig Abend*"
        Case Is = DateSerial(j, 12, 25)
            Feiertag = "EWeihnacht"
        Case Is = DateSerial(j, 12, 26)
            Feiertag = "ZWeihnacht"
        Case Is = DateSerial(j, 12, 31)
            Feiertag = "Silvester*"
        Case Else
            Feiertag = ""
    End Select
End Function 
     Code eingefügt mit Syntaxhighlighter 1.16


Gruss Rainer

  

Re: Wizig
von: Marc Voelker
Geschrieben am: 16.04.2003 - 08:36:16

Ja genau der isses.

die zellen sollen grau (code 15) eingefärbt werden, wenn das datum in zeile 1 mit einem datum der feiertage übereinstimmt. sprich wenn das datum in zelle 1 ein feiertag ist.

Gruß Marc