Código para personalizar una función

Hola ElProfe,

He revisado tu archivo y ahora entiendo el por que de la confusion. Revisa tu consulta incial, ahi dices los siguiente:

"...algoritmo es el siguiente (considerando las posiciones del entero de
izquierda a derecha):
+ ( Posición 01 * 71)
+ ( Posición 02 * 67)
+ ( Posición 03 * 59)
+ ( Posición 04 * 53)
...etc."

De ahi que Cristian y yo habiamos entendido que se tenia que ir de izquierda a derecha, anadiendo ceros a la derecha en caso de las
formulas (ya que la posicion 1 estaba a la izquierda).

Ahora, si n realidad es al reves, entonces efectivamente habria que cambiar las formulas y el codigo:

1) Usar dos formulas:
[B1]
=RESIDUO(SUMAPRODUCTO(--EXTRAE(TEXTO(A1;"000000000000000");FILA(INDIRECTO("1:15"));1)*{71;67;59;53;47;43;41;37;29;23;19;17;13;7;3});11)
[C1] =SI(B1>1;11-B1;B1)

2) Usar un nombre definido + formula:
-selecciona la celda [B1]
- menu Insertar>Nombre>Definir...
- nombre: RES
- se refiere a:
=RESIDUO(SUMAPRODUCTO(--EXTRAE(TEXTO(!A1;"000000000000000");FILA(INDIRECTO("1:15"));1)*{71;67;59;53;47;43;41;37;29;23;19;17;13;7;3});11)[B1] =SI(RES>1;11-RES;RES)B. En el mensaje anterior, puse la version incorrecta (sin acabar) de la funcion VBA, aqui va la buena:Option Base 1Function DC(Numero As String) As Integer Dim Mult As Variant, i As Integer, SumaProd As Double Dim Digito As Integer, RES As Integer Numero = Format(Numero, "000000000000000") Mult = Array(3, 7, 13, 17, 19, 23, 29, 37, 41, 43, 47, 53, 59, 67, 71) For i = 1 To 15 Digito = Mid(Numero, i, 1) SumaProd = SumaProd + Digito * Mult(i) Next i RES = SumaProd Mod 11 Select Case RES Case 0, 1: DC = RES Case Else: DC = 11 - RES End SelectEnd FunctionTe he enviado el archivo actualizado a tu correo electronivco.Saludos,KL

Huy, algo le ha pasado al fichero. A ver otra vez:

Saludos,
KL


Hola ElProfe,

He revisado tu archivo y ahora entiendo el por que de la confusion. Revisa tu consulta incial, ahi dices los siguiente:

"...algoritmo es el siguiente (considerando las posiciones del entero de
izquierda a derecha):
+ ( Posición 01 * 71)
+ ( Posición 02 * 67)
+ ( Posición 03 * 59)
+ ( Posición 04 * 53)
...etc."

De ahi que Cristian y yo habiamos entendido que se tenia que ir de izquierda a derecha, anadiendo ceros a la derecha en caso de las
formulas (ya que la posicion 1 estaba a la izquierda).

Ahora, si n realidad es al reves, entonces efectivamente habria que cambiar las formulas y el codigo:

1) Usar dos formulas:
[B1]
=RESIDUO(SUMAPRODUCTO(--EXTRAE(TEXTO(A1;"000000000000000");FILA(INDIRECTO("1:15"));1)*{71;67;59;53;47;43;41;37;29;23;19;17;13;7;3});11)
[C1] =SI(B1>1;11-B1;B1)

2) Usar un nombre definido + formula:
-selecciona la celda [B1]
- menu Insertar>Nombre>Definir...
- nombre: RES
- se refiere a:
=RESIDUO(SUMAPRODUCTO(--EXTRAE(TEXTO(!A1;"000000000000000");FILA(INDIRECTO("1:15"));1)*{71;67;59;53;47;43;41;37;29;23;19;17;13;7;3});11)[B1] =SI(RES>1;11-RES;RES)3) Funcion VBA.Option Base 1Function DC(Numero As String) As Integer Dim Mult As Variant, i As Integer, SumaProd As Double Dim Digito As Integer, RES As Integer Numero = Format(Numero, "000000000000000") Mult = Array(3, 7, 13, 17, 19, 23, 29, 37, 41, 43, 47, 53, 59, 67, 71) For i = 1 To 15 Digito = Mid(Numero, i, 1) SumaProd = SumaProd + Digito * Mult(i) Next i RES = SumaProd Mod 11 Select Case RES Case 0, 1: DC = RES Case Else: DC = 11 - RES End SelectEnd Function

KL;

Gracias por el recorderis; efectivamente acababa de evaluar que mi
planteamiento estaba errado al indicar que el numero era de izq a der,
allí estaba la falla.
Por lo demás, perfecto! las fórmulas funcionaron de maravilla!
En cambio el código VBA aun no logro hacerlo funcionar. Como le
comentaba a Cristian, si he notado que algunos caracteres se modifican
en los envios y estoy notando que son producto de esta herramienta;
allí podría estar la falla; no se.
Nuevamente te estoy haciendo llegar copia del archivo con las pruebas
de fórmulas y con el código VBA incorporado; por favor te agradezco
una última indicación para saber la causa de porque no funciona.
Deseo tener las dos alternativas (fórmulas y VBA)

KL; de nuevo graciaspor tu orientación y ayuda.
ElProfe

KL;
Doy alcance a mi nota anterior, para confirmarte que TODO funciona
perfectamente. Cuando la escribí aun no recibia tu correo.

Gracias
ElProfe

KL y Cristian, gracias por su ayuda;

Todo funcionó muy bien; fórmulas perfectas y codigo VBA perfecto!

Agradezco mucho su interés sin el cual no hubiera sido imposible
hacerlo tan sencillo como quedó. Gracias y disculpen tanta insistencia

Cordial saludo,

Manuel
(ElProfe)