algorytm.org

Implementacja w Basic



Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Wyznaczanie daty Wielkanocy - algortym Gaussa - Implementacja w Basic
Ocena użytkownikóww: *****  / 3
SłabyŚwietny
Nadesłany przez Tomasz, 30 grudnia 2014 13:46
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.
Pobierz pełne rozwiązanie.

Wielkanoc_Gauss.bas:
'Obliczanie daty wielkanocy - metoda Gaussa
'Stawicki Tomasz
'www.algorytm.org

Attribute VB_Name = "Module1"
Sub Wielkanoc()
Attribute Wielkanoc.VB_Description = "Makro zarejestrowane 2014-12-30, autor StawickiTomasz"
Attribute Wielkanoc.VB_ProcData.VB_Invoke_Func = " \n14"
Dim a, b, c, d, e As Integer
Dim w As Date
Dim year_v As Integer
Dim Avr As Integer
Dim Bvr As Integer

    year_v = 2014 'rok, który można wpisać na sztywno lub też pobrać z odpowiedniej komórki

    'przypisanie wartości liczb A i B dla właściwego zakresu lat
    If year_v <= 1582 Then
        Avr = 15
        Bvr = 6
    Else
        If year_v >= 1583 And _
            year_v <= 1699 Then
            Avr = 22
            Bvr = 2
        Else
            If year_v >= 1700 And _
                year_v < 1799 Then
                Avr = 23
                Bvr = 3
            Else
                If year_v >= 1800 And _
                    year_v < 1899 Then
                    Avr = 23
                    Bvr = 4
                Else
                    If year_v >= 1900 And _
                        year_v < 2099 Then
                        Avr = 24
                        Bvr = 5
                    Else
                        If year_v >= 2100 And _
                            year_v < 2199 Then
                            Avr = 24
                            Bvr = 6
                        Else
                            If year_v >= 2200 And _
                                year_v < 2299 Then
                                Avr = 25
                                Bvr = 0
                            Else
                                If year_v >= 2300 And _
                                    year_v < 2399 Then
                                    Avr = 26
                                    Bvr = 1
                                Else
                                    If year_v >= 2400 And _
                                        year_v < 2499 Then
                                        Avr = 25
                                        Bvr = 1
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
    
    'algorytm Gaussa
    a = year_v Mod 19
    b = year_v Mod 4
    c = year_v Mod 7
    d = (a * 19 + Avr) Mod 30
    e = (2 * b + 4 * c + 6 * d + Bvr) Mod 7

    'weryfikacja wyjątków
    If d = 29 And _
        e = 6 Or _
        d = 28 And _
        e = 6 Then
            w = DateSerial(year_v, 3, 22) + d + e - 7
    Else
        w = DateSerial(year_v, 3, 22) + d + e
    End If

End Sub







Komentarze
photo
0 # Comanche 2015-08-30 18:07
VBA dla Excel
Odpowiedz | Odpowiedz z cytatem | Cytować
photo
+1 # DamianD 2019-02-09 16:43
Zamiast potworka w postaci zagnieżdżonych IFów można by było użyć instrukcji SELECT CASE
Odpowiedz | Odpowiedz z cytatem | Cytować
Dodaj komentarz