Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Eduardo Machado

[Resolvido] Validação de Matrícula Dígito a Dígito

Recommended Posts

Boa tarde amigos programadores,

 

Criei um formulário que calcula o dígito verificador de matrículas com 8 dígitos sendo o último o dígito verificador com a ajuda de um colega também programador. Uma funcionária da minha empresa ficou satisfeita em descobrir o dígito verificador das matrículas de consumidores. Trabalhamos com várias delas todos os dias. São centenas de milhares de matrículas variadas que são analisadas ora via planilha excel, ora via documento do word, enfim... só que às vezes elas surgem mal digitadas e temos que descobrir também qual é o dígito correto em qualquer parte da matrícula.

Foi aí que surgiu a pergunta dessa colega, "e quando eu quiser descobrir qual é o dígito que falta no meio da matrícula ou quando o sistema acusa como matrícula incorreta e você tem que descobrir qual é o dígito que está errado?

Partindo dessa premissa eu dei uma retocada nesse programa e o código ficou assim no módulo (modMatricula):

 

Public Function ValidarMatricula(Matricula As Variant) As Boolean

On Error Resume Next

Dim Dig1, Dig2, Dig3, Dig4, Dig5, Dig6, Dig7, Dig8 As Long

Dim Soma, Soma1, DigVer As Integer

Dim ChkDig1, ChkDig2, ChkDig3, ChkDig4, ChkDig5, ChkDig6, ChkDig7, ChkDig8 As Boolean

Dim strMsg As String

Dim txtMatricula As String

Dim Total, Total1, Total2, Total3, Total4, Total5, Total6, Total7, Total8 As Integer

'1490154-2

Matricula = Format(Matricula, "00000000")

'Pega os digitos verificador da cadeia

DigVer = Right(Matricula, 1)

'Multiplica cada digito da cadeia pelo coeficiente crescente

Dig1 = Mid(Matricula, 8, 1) * 2

Dig2 = Mid(Matricula, 7, 1) * 3

Dig3 = Mid(Matricula, 6, 1) * 4

Dig4 = Mid(Matricula, 5, 1) * 5

Dig5 = Mid(Matricula, 4, 1) * 6

Dig6 = Mid(Matricula, 3, 1) * 7

Dig7 = Mid(Matricula, 2, 1) * 8

Dig8 = Mid(Matricula, 1, 1) * 9

'Soma os valores dos digitos já multiplicados

Soma = (Dig1) + (Dig2) + (Dig3) + (Dig4) + (Dig5) + (Dig6) + (Dig7) + (Dig8)

'Divide a Soma por 11

Soma1 = Soma Mod 11

'Multiplica cada digito da cadeia pelo coeficiente decrescente

Dig1 = Mid(Matricula, 7, 1) * 8

Dig2 = Mid(Matricula, 6, 1) * 7

Dig3 = Mid(Matricula, 5, 1) * 6

Dig4 = Mid(Matricula, 4, 1) * 5

Dig5 = Mid(Matricula, 3, 1) * 4

Dig6 = Mid(Matricula, 2, 1) * 3

Dig7 = Mid(Matricula, 1, 1) * 2

Total = (Dig1) + (Dig2) + (Dig3) + (Dig4) + (Dig5) + (Dig6) + (Dig7)

 

'Divide o Total por 11

Total1 = Total Mod 11 ' digito verificador

 

'Divide o Total por valores decrescentes

Total2 = Total Mod 10 ' 7º digito

Total3 = Total Mod 9 ' 6º dígito

Total4 = Total Mod 8 ' 5º digito

Total5 = Total Mod 7 ' 4º digito

Total6 = Total Mod 6 ' 3º digito

Total7 = Total Mod 5 ' 2º digito

Total8 = Total Mod 4 ' 1º digito

 

If Not IsNull(Forms!GeraMatricula!txtMatricula.Text) And (Forms!GeraMatricula!ChkDig1) Then

 

strMsg = strMsg & vbCrLf & vbCrLf

strMsg = strMsg & "(Para a Matrícula " & Forms!GeraMatricula!txtMatricula.Text

strMsg = strMsg & " o 1º dígito o correto é " & Total8 & ")"

MsgBox strMsg, vbExclamation, "1.ºDígito de matrícula"

 

ElseIf Not IsNull(Forms!GeraMatricula!txtMatricula.Text) And (Forms!GeraMatricula!ChkDig2) Then

 

strMsg = strMsg & vbCrLf & vbCrLf

strMsg = strMsg & "(Para a Matrícula " & Forms!GeraMatricula!txtMatricula.Text

strMsg = strMsg & " o 2º dígito o correto é " & Total7 & ")"

MsgBox strMsg, vbExclamation, "2.ºDígito de matrícula"

 

ElseIf Not IsNull(Forms!GeraMatricula!txtMatricula.Text) And (Forms!GeraMatricula!ChkDig3) Then

 

strMsg = strMsg & vbCrLf & vbCrLf

strMsg = strMsg & "(Para a Matrícula " & Forms!GeraMatricula!txtMatricula.Text

strMsg = strMsg & " o 3º dígito o correto é " & Total6 & ")"

MsgBox strMsg, vbExclamation, "3.ºDígito de matrícula"

 

ElseIf Not IsNull(Forms!GeraMatricula!txtMatricula.Text) And (Forms!GeraMatricula!ChkDig4) Then

 

strMsg = strMsg & vbCrLf & vbCrLf

strMsg = strMsg & "(Para a Matrícula " & Forms!GeraMatricula!txtMatricula.Text

strMsg = strMsg & " o 4º dígito o correto é " & Total5 & ")"

MsgBox strMsg, vbExclamation, "4.ºDígito de matrícula"

 

ElseIf Not IsNull(Forms!GeraMatricula!txtMatricula.Text) And (Forms!GeraMatricula!ChkDig5) Then

 

strMsg = strMsg & vbCrLf & vbCrLf

strMsg = strMsg & "(Para a Matrícula " & Forms!GeraMatricula!txtMatricula.Text

strMsg = strMsg & " o 5º dígito o correto é " & Total4 & ")"

MsgBox strMsg, vbExclamation, "5.ºDígito de matrícula"

 

ElseIf Not IsNull(Forms!GeraMatricula!txtMatricula.Text) And (Forms!GeraMatricula!ChkDig6) Then

 

strMsg = strMsg & vbCrLf & vbCrLf

strMsg = strMsg & "(Para a Matrícula " & Forms!GeraMatricula!txtMatricula.Text

strMsg = strMsg & " o 6º dígito o correto é " & Total3 & ")"

MsgBox strMsg, vbExclamation, "6.ºDígito de matrícula"

 

ElseIf Not IsNull(Forms!GeraMatricula!txtMatricula.Text) And (Forms!GeraMatricula!ChkDig7) Then

 

strMsg = strMsg & vbCrLf & vbCrLf

strMsg = strMsg & "(Para a Matrícula " & Forms!GeraMatricula!txtMatricula.Text

strMsg = strMsg & " o 7º dígito o correto é " & Total2 & ")"

MsgBox strMsg, vbExclamation, "7.ºDígito de matrícula"

 

ElseIf Not IsNull(Forms!GeraMatricula!txtMatricula.Text) And (Forms!GeraMatricula!ChkDig8) Then

 

strMsg = strMsg & vbCrLf & vbCrLf

strMsg = strMsg & "(Para a Matrícula " & Forms!GeraMatricula!txtMatricula.Text

strMsg = strMsg & " o dígito verificador o correto é " & Total1 & ")"

MsgBox strMsg, vbExclamation, "8.ºDígito de matrícula"

 

 

Else

MsgBox "Matrícula em Teste!"

End If

DoCmd.CancelEvent

 

End Function

 

Só que eu não estou conseguindo a contento, só o oitavo dígito(o dígito verificador) está certo, sinto que estou perto. Será que a minha lógica está errada? Alguém pode me dar uma luz aqui? Obrigado!

 

http://www.esnips.com/doc/49b98d63-a4ad-41...ão_de_Matrícula

Compartilhar este post


Link para o post
Compartilhar em outros sites

Bom dia amigos,

 

Foi bom ninguém postar uma resposta, pois tive tempo de pensar em possíveis soluções. Por ora, vou ficar com essa solução básica abaixo:

 

Public Function ValidarMatricula(Matricula As Variant) As Boolean

On Error Resume Next

Dim Dig1, Dig2, Dig3, Dig4, Dig5, Dig6, Dig7, Dig8 As Long

Dim Soma, Soma1, DigVer As Integer

Dim txtMatricula As String

Dim Total, Total1 As Integer

Dim D1, D2, D3, D4, D5, D6, D7, D8 As Integer

'1490154-2

Matricula = Format(Matricula, "00000000")

'Pega os digitos verificador da cadeia

DigVer = Right(Matricula, 1)

'Multiplica cada digito da cadeia pelo coeficiente crescente

Dig1 = Mid(Matricula, 8, 1) * 2

Dig2 = Mid(Matricula, 7, 1) * 3

Dig3 = Mid(Matricula, 6, 1) * 4

Dig4 = Mid(Matricula, 5, 1) * 5

Dig5 = Mid(Matricula, 4, 1) * 6

Dig6 = Mid(Matricula, 3, 1) * 7

Dig7 = Mid(Matricula, 2, 1) * 8

Dig8 = Mid(Matricula, 1, 1) * 9

'Soma os valores dos digitos já multiplicados

Soma = (Dig1) + (Dig2) + (Dig3) + (Dig4) + (Dig5) + (Dig6) + (Dig7) + (Dig8)

'Divide a Soma por 11

Soma1 = Soma Mod 11

'Multiplica cada digito da cadeia pelo coeficiente decrescente

Dig1 = Mid(Matricula, 7, 1) * 8

Dig2 = Mid(Matricula, 6, 1) * 7

Dig3 = Mid(Matricula, 5, 1) * 6

Dig4 = Mid(Matricula, 4, 1) * 5

Dig5 = Mid(Matricula, 3, 1) * 4

Dig6 = Mid(Matricula, 2, 1) * 3

Dig7 = Mid(Matricula, 1, 1) * 2

Total = (Dig1) + (Dig2) + (Dig3) + (Dig4) + (Dig5) + (Dig6) + (Dig7)

'Divide o Total por 11

Total1 = Total Mod 11 ' digito verificador

 

D1 = Mid(Matricula, 1, 1)

D2 = Mid(Matricula, 2, 1)

D3 = Mid(Matricula, 3, 1)

D4 = Mid(Matricula, 4, 1)

D5 = Mid(Matricula, 5, 1)

D6 = Mid(Matricula, 6, 1)

D7 = Mid(Matricula, 7, 1)

D8 = Mid(Matricula, 8, 1)

 

 

If Not IsNull(Forms!GeraMatricula!txtMatricula.Text) And Total1 Mod 11 = D8 Then

 

MsgBox "Matrícula válida!"

 

Else

MsgBox "Matrícula Inválida. Check dígitos 5 por 6, 0 por 8, 6 por 5 e 8 por 0!", vbExclamation, "Dígito da Matrícula?"

End If

DoCmd.CancelEvent

End Function

Compartilhar este post


Link para o post
Compartilhar em outros sites

Bom dia amigos,

 

Foi bom ninguém postar uma resposta, pois tive tempo de pensar em possíveis soluções. Por ora, vou ficar com essa solução básica abaixo:

 

Public Function ValidarMatricula(Matricula As Variant) As Boolean

On Error Resume Next

Dim Dig1, Dig2, Dig3, Dig4, Dig5, Dig6, Dig7, Dig8 As Long

Dim Soma, Soma1, DigVer As Integer

Dim txtMatricula As String

Dim Total, Total1 As Integer

Dim D1, D2, D3, D4, D5, D6, D7, D8 As Integer

'1490154-2

Matricula = Format(Matricula, "00000000")

'Pega os digitos verificador da cadeia

DigVer = Right(Matricula, 1)

'Multiplica cada digito da cadeia pelo coeficiente crescente

Dig1 = Mid(Matricula, 8, 1) * 2

Dig2 = Mid(Matricula, 7, 1) * 3

Dig3 = Mid(Matricula, 6, 1) * 4

Dig4 = Mid(Matricula, 5, 1) * 5

Dig5 = Mid(Matricula, 4, 1) * 6

Dig6 = Mid(Matricula, 3, 1) * 7

Dig7 = Mid(Matricula, 2, 1) * 8

Dig8 = Mid(Matricula, 1, 1) * 9

'Soma os valores dos digitos já multiplicados

Soma = (Dig1) + (Dig2) + (Dig3) + (Dig4) + (Dig5) + (Dig6) + (Dig7) + (Dig8)

'Divide a Soma por 11

Soma1 = Soma Mod 11

'Multiplica cada digito da cadeia pelo coeficiente decrescente

Dig1 = Mid(Matricula, 7, 1) * 8

Dig2 = Mid(Matricula, 6, 1) * 7

Dig3 = Mid(Matricula, 5, 1) * 6

Dig4 = Mid(Matricula, 4, 1) * 5

Dig5 = Mid(Matricula, 3, 1) * 4

Dig6 = Mid(Matricula, 2, 1) * 3

Dig7 = Mid(Matricula, 1, 1) * 2

Total = (Dig1) + (Dig2) + (Dig3) + (Dig4) + (Dig5) + (Dig6) + (Dig7)

'Divide o Total por 11

Total1 = Total Mod 11 ' digito verificador

 

D1 = Mid(Matricula, 1, 1)

D2 = Mid(Matricula, 2, 1)

D3 = Mid(Matricula, 3, 1)

D4 = Mid(Matricula, 4, 1)

D5 = Mid(Matricula, 5, 1)

D6 = Mid(Matricula, 6, 1)

D7 = Mid(Matricula, 7, 1)

D8 = Mid(Matricula, 8, 1)

 

 

If Not IsNull(Forms!GeraMatricula!txtMatricula.Text) And Total1 Mod 11 = D8 Then

 

MsgBox "Matrícula válida!"

 

Else

MsgBox "Matrícula Inválida. Check dígitos 5 por 6, 0 por 8, 6 por 5 e 8 por 0!", vbExclamation, "Dígito da Matrícula?"

End If

DoCmd.CancelEvent

End Function

 

Modifiquei todo o código anterior que só me servia para me desafiar a melhorá-lo. Ele ficou assim:

 

http://www.esnips.com/doc/1cdc2f1f-ef44-4f...Dígito_a_Dígito

 

Option Compare Database

Option Explicit

 

Private Function ValidacaoMatricula()

On Error Resume Next

Dim Dig1, Dig2, Dig3, Dig4, Dig5, Dig6, Dig7, Dig8, txtTotal, txtD As Long

Dim D1, D2, D3, D4, D5, D6, D7, D8, Soma, Soma1 As Integer

 

 

Dig1 = Me.D8.Value * 2

Dig2 = Me.D7.Value * 3

Dig3 = Me.D6.Value * 4

Dig4 = Me.D5.Value * 5

Dig5 = Me.D4.Value * 6

Dig6 = Me.D3.Value * 7

Dig7 = Me.D2.Value * 8

Dig8 = Me.D1.Value * 9

'Soma os valores dos digitos já multiplicados

Soma = (Dig1) + (Dig2) + (Dig3) + (Dig4) + (Dig5) + (Dig6) + (Dig7) + (Dig8)

'Divide a Soma por 11

Soma1 = Soma Mod 11

 

Dig1 = Me.D7.Value * 8

Dig2 = Me.D6.Value * 7

Dig3 = Me.D5.Value * 6

Dig4 = Me.D4.Value * 5

Dig5 = Me.D3.Value * 4

Dig6 = Me.D2.Value * 3

Dig7 = Me.D1.Value * 2

 

Me.txtTotal.Value = Dig1 + Dig2 + Dig3 + Dig4 + Dig5 + Dig6 + Dig7

 

'Divide o txtTotal por 11

Me.txtD.Value = Me.txtTotal.Value Mod 11 ' digito verificador

If Me.txtD.Value = Me.txtDiv.Value Then

MsgBox "Dígitos verificadores batem. Matrícula Válida !", vbInformation, "Confirmação de Matrícula"

Else

DoCmd.CancelEvent

End If

On Error GoTo 0

End Function

 

Private Sub B1_Click()

On Error Resume Next

Select Case D1

Case Is = 1, 2, 3, 4, 5, 6, 7, 8, 9

Me.D1.Value = Me.D1.Value - 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub B2_Click()

Select Case D2

Case Is = 1, 2, 3, 4, 5, 6, 7, 8, 9

Me.D2.Value = Me.D2.Value - 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub B3_Click()

Select Case D3

Case Is = 1, 2, 3, 4, 5, 6, 7, 8, 9

Me.D3.Value = Me.D3.Value - 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub B4_Click()

Select Case D4

Case Is = 1, 2, 3, 4, 5, 6, 7, 8, 9

Me.D4.Value = Me.D4.Value - 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub B5_Click()

Select Case D5

Case Is = 1, 2, 3, 4, 5, 6, 7, 8, 9

Me.D5.Value = Me.D5.Value - 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub B6_Click()

Select Case D6

Case Is = 1, 2, 3, 4, 5, 6, 7, 8, 9

Me.D6.Value = Me.D6.Value - 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub B7_Click()

Select Case D7

Case Is = 1, 2, 3, 4, 5, 6, 7, 8, 9

Me.D7.Value = Me.D7.Value - 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub B8_Click()

Select Case D8

Case Is = 1, 2, 3, 4, 5, 6, 7, 8, 9

Me.D8.Value = Me.D8.Value - 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub CD1_Click()

On Error Resume Next

Select Case D1

Case Is = 0, 1, 2, 3, 4, 5, 6, 7, 8

Me.D1.Value = Me.D1.Value + 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub CD2_Click()

On Error Resume Next

'Do While Me.txtD.Value <> Me.txtD.Value

Select Case D2

Case Is = 0, 1, 2, 3, 4, 5, 6, 7, 8

Me.D2.Value = Me.D2.Value + 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub CD3_Click()

Select Case D3

Case Is = 0, 1, 2, 3, 4, 5, 6, 7, 8

Me.D3.Value = Me.D3.Value + 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub CD4_Click()

Select Case D4

Case Is = 0, 1, 2, 3, 4, 5, 6, 7, 8

Me.D4.Value = Me.D4.Value + 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub CD5_Click()

Select Case D5

Case Is = 0, 1, 2, 3, 4, 5, 6, 7, 8

Me.D5.Value = Me.D5.Value + 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub CD6_Click()

Select Case D6

Case Is = 0, 1, 2, 3, 4, 5, 6, 7, 8

Me.D6.Value = Me.D6.Value + 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub CD7_Click()

Select Case D7

Case Is = 0, 1, 2, 3, 4, 5, 6, 7, 8

Me.D7.Value = Me.D7.Value + 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub CD8_Click()

Select Case D8

Case Is = 0, 1, 2, 3, 4, 5, 6, 7, 8

Me.D8.Value = Me.D8.Value + 1

End Select

Call ValidacaoMatricula

End Sub

Private Sub Form_Close()

End Sub

Private Sub Form_Open(Cancel As Integer)

MsgBox "Digite uma matrícula!"

Me.Caption = "Você visitou este formulário às " & Format$(Now(), "h:nn:ss DD/MM/YYYY")

End Sub

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.