PESEL - makro
: ndz kwie 11, 2021 2:00 pm
Napisałem kilka funkcji, może komuś się przyda.
PESEL_OK - sprawdza czy podany PESEL jest poprawny
(funkcje poniżej nie sprawdzają poprawności PESELu!)
PESEL_DATA - zwraca datę urodzenia z podanego numeru PESEL
PESEL_PLEC - zwraca płeć, K (kobieta) albo M (mężczyzna)
PESEL_K - zwraca prawdę jeśli pesel należy do kobiety
PESEL_M - zwraca prawdę jeśli pesel należy do mężczyzny
Żeby je dodać do arkusza wybierz:
Narzędzia > Makra > Zarządzaj makrami > Basic
Wybierz swój plik, kliknij "Nowy", "OK", zastąp tekst kodem poniżej, zapisz makro (Plik > Zapisz) i zamknij okno.
PESEL_OK - sprawdza czy podany PESEL jest poprawny
(funkcje poniżej nie sprawdzają poprawności PESELu!)
PESEL_DATA - zwraca datę urodzenia z podanego numeru PESEL
PESEL_PLEC - zwraca płeć, K (kobieta) albo M (mężczyzna)
PESEL_K - zwraca prawdę jeśli pesel należy do kobiety
PESEL_M - zwraca prawdę jeśli pesel należy do mężczyzny
Żeby je dodać do arkusza wybierz:
Narzędzia > Makra > Zarządzaj makrami > Basic
Wybierz swój plik, kliknij "Nowy", "OK", zastąp tekst kodem poniżej, zapisz makro (Plik > Zapisz) i zamknij okno.
Kod: Zaznacz cały
Function PESEL_OK(pesel As String) As Boolean
Dim i%, i2%, cyfra%, suma%, wagi (10) as Integer
If Len(pesel) = 11 Then
wagi = Array(1, 3, 7, 9, 1, 3, 7, 9, 1, 3, 1)
suma=0
i2=1
For i = LBound(wagi) To UBound(wagi)
cyfra=Mid(pesel, i2, 1)
suma=suma+(cyfra*wagi(i))
i2=i2+1
Next
PESEL_OK=(suma MOD 10) = 0
Else
PESEL_OK=False
End If
End Function
Function PESEL_DATA(pesel As String) As Date
On Error GoTo ErrorHandler
Dim stulecie%, rok%, miesiac%, dzien%, rok2%
rok=Mid(pesel, 1, 2)
miesiac=Mid(pesel, 3, 2)
dzien=Mid(pesel, 5, 2)
stulecie=1
While miesiac > 20
miesiac=miesiac-20
stulecie=stulecie+1
Wend
rok2=Choose(stulecie, 1900, 2000, 2100, 2200, 1800)
If miesiac = 0 Then miesiac=1
If dzien = 0 Then dzien=1
PESEL_DATA=DateSerial(rok+rok2, miesiac, dzien)
Exit Function
ErrorHandler:
PESEL_DATA=DateSerial(0, 1, 1)
End Function
Function PESEL_K(pesel As String) As Boolean
Dim cyfra%
cyfra=Mid(pesel, 10, 1)
PESEL_K=(cyfra MOD 2) = 0
End Function
Function PESEL_M(pesel As String) As Boolean
PESEL_M=Not PESEL_K(pesel)
End Function
Function PESEL_PLEC(pesel As String) As String
If PESEL_K(pesel) Then PESEL_PLEC="K" Else PESEL_PLEC="M"
End Function