Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Sprawdzanie poprawności wpisanego NIP-u

szunaj85 · forumowicz Posty: 20

Kod:

Option Explicit

Function Czy_poprawny_NIP(ByVal sNIP As String) As Boolean
'***************************************************************
' Pobrano z http://www.bardzki.pl
' -------------------------------
' Mozesz korzystac z ponizszego kodu w dowolnych zastosowaniach
' pod warunkiem pozostawienia tego komentarza.
' Usunięcie komentarza bedzie naruszeniem praw autorskich
' i jest zagrozone sankcjami wynikajacymi z prawa autorskiego
' i praw pokrewnych.
'***************************************************************

Dim aWagi As Variant 'zmienna tablicowa, do ktorej przypiszemy tablice wag
Dim nSuma As Long 'zmianna, do ktorej przypiszemy sume iloczynow
Dim lPoprawny_NIP As Boolean 'True - jesli NIP jest poprawnie zweryfikowany
Dim i As Integer 'zmienna iteracyjna

lPoprawny_NIP = False 'zakladamy, ze NIP jest bledy
aWagi = Array(6, 5, 7, 2, 3, 4, 5, 6, 7) 'tablica wartosci wag algorytmu Luhn'a
sNIP = Trim(sNIP) 'dla pewnosci usuwamy niedrukowalne znaki przed i za numerem NIP
sNIP = Replace(sNIP, " ", "") 'usuwamy wszystkie znaki " "
sNIP = Replace(sNIP, "-", "") 'usuwamy wszystkie znaki "-"
nSuma = 0 'zerujemy zmienna sumatora

If IsNumeric(sNIP) And Len(sNIP) = 10 Then 'jesli NIP sklada sie dokladnie z 10-ciu cyfr to ...
For i = 1 To 9 'dla 9-ciu znakow wyliczamy iloczyny waga[i] * NIP[i]
nSuma = nSuma + aWagi(i - 1) * CInt(Mid(sNIP, i, 1))
Next i
If (nSuma Mod 11) = CInt(Right(sNIP, 1)) Then lPoprawny_NIP = True 'jesli wyliczona reszta = cyfrze kontrolnej NIP jest poprawny
End If

Czy_poprawny_NIP = lPoprawny_NIP
End Function

Znalazłem taki kod. W tej chwili kod ten sprawdza nip w kolumnie A i wyświetla wynik w postaci "PRAWDA" lub "FAŁSZ" w kolumnie B. Jak go przebudować tak aby zamiast wyświetlać wynik w kolumnie B podświetlał w czasie rzeczywistym na kolor tylko tą komórkę gdzie NIP jest źle wpisany?
Dla ułatwienia dodałem załącznik.

czy_poprawny_nip.rar

Pobierz Plik ściągnięto 7 raz(y) 17.84 KB

wuzeq · Excel Expert **Pomógł:** 142 razy Posty: 451

Ustaw formatowanie warunkowe na podstawie formuły

Kod:

=NIE(Czy_poprawny_NIP(A2))

i ustawić formatowanie oraz odpowiedni zakres

szunaj85 · forumowicz Posty: 20

Widzę, że tu nie powinno być problemu bo wygląda, że działa.
Jednak za błędne bierze on również puste, nie wypełnione komórki z kolumny A. Da się temu jakoś zapobiec?

wuzeq · Excel Expert **Pomógł:** 142 razy Posty: 451

Kod:

=ORAZ(A1<>"";NIE(Czy_poprawny_NIP(A1)))

OShon · Wysłany: 2012-02-08, 15:59

No to myślę ze to jest rozwiązanie jakie interesuje pytającego:

Kod:

Public Function CzyNIPPoprawny(sNIP As String) As Integer
Dim iWagi As Variant, i As Integer, iSumaKon As Integer
Application.Volatile
On Error GoTo Err_CzyNIPPoprawny
iWagi = Array(6, 5, 7, 2, 3, 4, 5, 6, 7)

If Len(sNIP) <> 10 Then Err.Raise 1 + 512
For i = LBound(iWagi) To UBound(iWagi)
iSumaKon = iSumaKon + (iWagi(i) * CInt(Mid(sNIP, i + 1, 1)))
Next i

iSumaKon = iSumaKon Mod 11
CzyNIPPoprawny = CBool(CInt(Mid(sNIP, 10, 1)) = iSumaKon)

Exit_CzyNIPPoprawny:
Exit Function

Err_CzyNIPPoprawny:
CzyNIPPoprawny = 0
Err.Clear
Resume Exit_CzyNIPPoprawny
End Function

XL_Formatowanie_warunkowe_NIP.png

Plik ściągnięto 14 raz(y) 88.94 KB

szunaj85 · forumowicz Posty: 20

Cytat:

No to myślę ze to jest rozwiązanie jakie interesuje pytającego:

Owszem jak najbardziej zainteresowało, ale kod ma jedną wadę, mianowicie nie akceptuje NIP-ów z myślnikami, czyli w formacie xxx-xxx-xx-xx oraz xxx-xx-xx-xxx tylko w formie ciągu znaków. Poza tym tak jak już wcześniej napisałem również w tym wypadku za błędne bierze on również puste, nie wypełnione komórki.

Raffix · EXCELent Man **Pomógł:** 3 razy Posty: 115

A ja proponowałbym do wprowadzania danych użyć userforma, w userformie wstawić odpowiednie maski dla textboxów (dostępne na FAQ) plus kodzik na sprawdzenie poprawności przed wprowadzeniem do arkusza i nigdy i nie będziesz miał problemu z błędnymi nipami :-)

i

OShon · Wysłany: 2012-02-08, 20:44

wuzeq · Excel Expert **Pomógł:** 142 razy Posty: 451

A po co wprowadzać dwie reguły, jak można to umieścić w jednej ? Patrz post powyżej