VALIDAR C/C BRADESCO

LUCIANORW 17/11/2009 15:55:41
#327957
Boa tarde!!!
Tenho uma rotina para validar a C/C do Bradesco, que funciona, aparetemente sem problemas, mas como não tenho a expertise do pessoal daqui no fórum, resolvi postar para ver se podem me ajudar a reduzir o tamanho do módulo.
[]s
Luciano

Function verifica_cc(vnumcc As String, vdigito)
    Dim numcc As String, vresultado As Integer, vdv As String
    Dim v1 As Integer, v2 As Integer, v3 As Integer, v4 As Integer, v5 As Integer, v6 As Integer
    Dim fator1 As Integer, fator2 As Integer, fator3 As Integer, fator4 As Integer, fator5 As Integer, fator6 As Integer
    numcc = CInt(vnumcc)
    If CInt(vnumcc) > [Ô]899999[Ô] Then
        MsgBox [Ô]Número não pode exceder 899999.[Ô], vbInformation, NomeSistema
        Exit Function
    End If

    qtde = Len(numcc)
    For i = 1 To qtde
        If i = 1 Then
            v1 = qtde + 1
            fator1 = Mid(numcc, i, 1)
            fator1 = fator1 * v1
        End If

        If i = 2 Then
            v2 = v1 - 1
            fator2 = Mid(numcc, i, 1)
            fator2 = fator2 * v2
        End If

        If i = 3 Then
            v3 = v2 - 1
            fator3 = Mid(numcc, i, 1)
            fator3 = fator3 * v3
        End If

        If i = 4 Then
            v4 = v3 - 1
            fator4 = Mid(numcc, i, 1)
            fator4 = fator4 * v4
        End If

        If i = 5 Then
            v5 = v4 - 1
            fator5 = Mid(numcc, i, 1)
            fator5 = fator5 * v5
        End If

        If i = 6 Then
            v6 = v5 - 1
            fator6 = Mid(numcc, i, 1)
            fator6 = fator6 * v6
        End If
    Next i
    vresultado = Nz(fator1, 0) + Nz(fator2, 0) + Nz(fator3, 0) + Nz(fator4, 0) + Nz(fator5, 0) + Nz(fator6, 0)
    vresultado = vresultado Mod 11
    
    If vresultado > 0 Then
        vresultado = 11 - vresultado
    End If
    
    If vresultado = 10 Then
        vdv = [Ô]P[Ô]
    Else
        vdv = vresultado
    End If

    If vdigito <> vdv Then
        Beep
        MsgBox [Ô]Dígito informado não confere.[Ô], vbInformation, NomeSistema
    End If
End Function
PH1959 17/11/2009 16:33:05
#327959 Resposta escolhida
dá para resumir um pouco...
Function verifica_cc(vnumcc As String, vdigito)
Dim numcc As String, vresultado As Integer, vdv As String
Dim v1 As Integer, v2 As Integer, v3 As Integer, v4 As Integer, v5 As Integer, v6 As Integer
Dim fator1 As Integer, fator2 As Integer, fator3 As Integer, fator4 As Integer, fator5 As Integer, fator6 As Integer
numcc = CInt(vnumcc)
If CInt(vnumcc) > [Ô]899999[Ô] Then
MsgBox [Ô]Número não pode exceder 899999.[Ô], vbInformation, NomeSistema
Exit Function
End If

qtde = Len(numcc)
For i = 1 To qtde
select case i
case 1
v1 = qtde + 1
fator1 = Mid(numcc, i, 1)
fator1 = fator1 * v1
case 2
v2 = v1 - 1
fator2 = Mid(numcc, i, 1)
fator2 = fator2 * v2
case 3
v3 = v2 - 1
fator3 = Mid(numcc, i, 1)
fator3 = fator3 * v3
case 4 Then
v4 = v3 - 1
fator4 = Mid(numcc, i, 1)
fator4 = fator4 * v4

case 5
v5 = v4 - 1
fator5 = Mid(numcc, i, 1)
fator5 = fator5 * v5
case 6
v6 = v5 - 1
fator6 = Mid(numcc, i, 1)
fator6 = fator6 * v6
End select
Next i
vresultado = Nz(fator1, 0) + Nz(fator2, 0) + Nz(fator3, 0) + Nz(fator4, 0) + Nz(fator5, 0) + Nz(fator6, 0)
vresultado = vresultado Mod 11
select case Vresultado
case >0
vresultado = 11 - vresultado

case = 10 Then
vdv = [Ô]P[Ô]
case else
vdv = vresultado
End select
If vdigito <> vdv Then
Beep
MsgBox [Ô]Dígito informado não confere.[Ô], vbInformation, NomeSistema
End If
End Function
Tópico encerrado , respostas não são mais permitidas
Voltar