Visual Basic for Applications en ejemplos(VII): Calcular el número cabalístico

En está serie de ejercicios de VBA hemos visto varias funciones y muchos ejemplos de cómo emplear Microsoft Office Excel VBA. Desde sencillos cálculos hasta algunos más complejos. En está ocasión calcularemos el número cabalístico de diferentes personas (algunas famosas como Bill Gates o Michael Jackson y la mayoría comunes). Para ello necesitaremos lo siguiente:

1. Definir un diccionario (estructuras de datos con llave y valor).
2. El algoritmo para calcular el número cabalístico.
3. Un botón para lanzar el evento.

El diccionario estará basado en la tabla de conversión de valores de letras a números del Profesor Lester (investiga si estás interesado en el tema).

1	2	3	4	5	6	7	8	9
A	B	C	D	E	F	G	H	I
J	K	L	M	N	O	P	Q	R
S	T	U	V	W	X	Y	Z	Ñ

Definiremos un rango de A2 a A6. Agregamos nombres y asignaremos el rango.

Dim Rango As Range

Range("A2").Value = "JUAN PEREZ PEREZ"
Range("A3").Value = "BILL GATES"
Range("A4").Value = "STANLEY KUBRICK"
Range("A5").Value = "IVANKA TRUMP"
Range("A6").Value = "LADY GAGA"

'Definimos el rango
Set Rango = Range("A2:A6")

Recorreremos cada una de las celdas con un For Each In ... Next.

Dim Conteo As Integer

Conteo = 2 ' Porque iniciamos desde A2

'El resultado irá en la columna B

For Each Element In Rango
    Range("B" & Conteo) = Funcion()
    Conteo = Conteo + 1
Next Element

'Donde Funcion() será la función que se encargará de realizar los cálculos 

El nombre de la función será CalculoNumero y recibirá un String como parámetro.

Public Function CalculoNumero(Nombre As String) As String

'Aquí los cálculos

End Function

Para definir un diccionario en Visual Basic for Applications necesitamos agregar la librería o complemento necesario.

Menú => Herramientas => Referencias.

Elegiremos Microsoft Scripting Runtime. Aceptamos.

Ahora ya podemos definir un diccionario.

Dim Diccionario As Scripting.Dictionary

Agregamos el diccionario.

Set Diccionario = New Scripting.Dictionary

Llenamos el diccionario (basándonos en la tabla de arriba).

Diccionario.Add "A", 1
Diccionario.Add "J", 1
Diccionario.Add "S", 1
' más valores
' ...

Para acceder al valor de un diccionario podemos hacer lo siguiente:

'La llave será A y su valor 1
MsgBox Diccionario("A") 'Valor = 1

Sumaremos cada una de las letras del nombre accediendo a cada uno de las llaves de diccionario:

Dim Suma As Integer
Dim Contador As Integer

Suma = 0

For Contador = 1 To Len(Nombre)
    Suma = Suma + Diccionario(Mid(Nombre, Contador, 1))
Next Contador

Si la entrada es ANA tendremos:
A = 1
N = 5
A = 1

El resultado será 7.

Nota: Los números maestros en la numerología son 11, 22 y 33. Si algún nombre cuya suma sea igual a cualquiera de estos tres números se pondrá la etiqueta de Número maestro.

Select Case Suma
   Case 11: Resultado = Resultado & " Número maestro " & Suma
   Case 22: Resultado = Resultado & " Número maestro " & Suma
   Case 33: Resultado = Resultado & " Número maestro " & Suma
   Case Else:
     'Hacer otros cálculos
End Select

Código completo.

Función principal

Public Sub Test()
Dim Rango As Range
Dim Element As Variant
Dim Conteo As Integer

Range("A2").Value = "ANA PEREZ GIL"
Range("A3").Value = "BILL GATES"
Range("A4").Value = "STANLEY KUBRICK"
Range("A5").Value = "IVANKA TRUMP"
Range("A6").Value = "LADY GAGA"

Set Rango = Range("A2:A6")
Conteo = 11

For Each Element In Rango
    Range("B" & Conteo) = CalculoNumero(CStr(Element))
    Conteo = Conteo + 1
Next Element


End Sub

Función CalculoNumero.

Public Function CalculoNumero(Nombre As String) As String
Dim Element As Variant
Dim Contador As Long
Dim Suma As Integer
Dim Resultado As String
Dim Diccionario As Scripting.Dictionary
Dim Tam As Integer
Dim SumaFinal As Integer
Dim CadenaTmp As String


Resultado = " "

'Diccionario Profesor Lester
Set Diccionario = New Scripting.Dictionary

Diccionario.Add "A", 1
Diccionario.Add "J", 1
Diccionario.Add "S", 1

Diccionario.Add "B", 2
Diccionario.Add "K", 2
Diccionario.Add "T", 2

Diccionario.Add "C", 3
Diccionario.Add "L", 3
Diccionario.Add "U", 3

Diccionario.Add "D", 4
Diccionario.Add "M", 4
Diccionario.Add "V", 4

Diccionario.Add "E", 5
Diccionario.Add "N", 5
Diccionario.Add "W", 5

Diccionario.Add "F", 6
Diccionario.Add "O", 6
Diccionario.Add "X", 6

Diccionario.Add "G", 7
Diccionario.Add "P", 7
Diccionario.Add "Y", 7

Diccionario.Add "H", 8
Diccionario.Add "Q", 8
Diccionario.Add "Z", 8

Diccionario.Add "I", 9
Diccionario.Add "R", 9
Diccionario.Add "Ñ", 9



Suma = 0

For Contador = 1 To Len(Nombre)
    'Debug.Print Mid(Nombre, Contador, 1) & " Contador: " & Contador
    Suma = Suma + Diccionario(Mid(Nombre, Contador, 1))
Next Contador

'Debug.Print "Suma: " & Suma

Select Case Suma
   Case 11: Resultado = Resultado & " Número maestro " & Suma
   Case 22: Resultado = Resultado & " Número maestro " & Suma
   Case 33: Resultado = Resultado & " Número maestro " & Suma
   Case Else:
   Tam = Len(CStr(Suma))
   CadenaTmp = CStr(Suma)
   'Debug.Print "Tam = " & Tam
   
   SumaFinal = 0
   Contador = 0
   
   If Tam >= 2 Then
      For Contador = 1 To Tam
         SumaFinal = SumaFinal + CInt(Mid(CadenaTmp, Contador, 1))
      Next Contador
      Resultado = Resultado & CStr(SumaFinal)
   End If
   
   
End Select

'Debug.Print "Nombre: " & Nombre; " ,Resultado: " & Resultado

CalculoNumero = "Longitud: " & Len(Nombre) & " , Nombre: " & Nombre & " , Resultado:" & Resultado

End Function

El botón disparará el evento

Private Sub CommandButton1_Click()
Call Test
End Sub

Este tan sólo un ejemplo de miles y miles de cómo emplear VBA para cualquier proyecto.

Links:
https://www.wemystic.com/es/numerologia-cabalistica/