CALCULAR LA EDAD CON DATEDIF EN UN FORMULARIO DE EXCEL

Hola a todos, espero que estéis bien y supongo que ya disfrutando de vacaciones (a mí aún me quedan unas semanas para comenzarlas).

En el post de hoy vamos a tratar de resolver una consulta que me enviaron la semana pasada sobre un tema que ya hace tiempo que tenía ganas de abordar. La pregunta era cómo se podía calcular la edad en un formulario de Excel.

Bien, existen varios post sobre el cálculo de la edad en esta web, y en todas ellas usamos la función SIFECHA() de excel, que normalmente la usamos en la hoja y en menor medida en VBA. En VBA esta función se denomina DATEDIF (y NO es lo mismo que otra función denominada DATEDIFF, que trabaja con valores absolutos).

Esta función, si utilizamos la grabadora de datos para obtener su traducción en VBA sería algo así:

AÑO = "=DATEDIF(RC[-12],TODAY(),""Y"")"

Es decir, nos ofrece la posibilidad de generar la fórmula en la hoja desde VBA. Pero lo cierto es que queremos trabajar con esta función sin acudir a la hoja en ningún momento, simplemente utilizar el formulario y los parámetros que hayamos incluido para calcular la edad de una persona.

Aunque esta función no existe en VBA como tal, podemos invocarla a través del método EVALUATE, aunque eso lo iremos viendo en el caso particular que nos ocupa.

Vamos a imaginar que tenemos un formulario con un cuadro de texto (textbox1) en el que debemos incluir la fecha de nacimiento, un botón de comando para ejecutar la macro y otro cuadro de texto (textbox2) en el que vamos a mostrar la edad completa:

CALCULAR LA EDAD EN UN FORMULARIO

Para calcular la edad vamos a incluir en modulo asociado al botón de comando el siguiente código:

Private Sub CommandButton1_Click()
'Definimos variables
Dim validarfecha As Boolean
Dim hoy As String
Dim f_nac As String
Dim año As Double, mes As Double, dia As Double
'Trabajamos con el formulario1
With UserForm1
'Cada vez que ejecutemos la macro vaciaremos el textbox1
.TextBox2 = Empty
'Si no existe fecha o el dato no es una fecha o está mal escrita, activamos mensaje y salimos el cálculo
validarfecha = IsDate(.TextBox1.Value)
If .TextBox1.Value = Empty Or validarfecha = False Or Len(.TextBox1.Value) > 10 Then
MsgBox ("DEBES INTRODUCIR UNA FECHA Y VERIFICAR QUE EL FORMATO SEA EL ADECUADO"), vbExclamation, "CONTROL"
Exit Sub
End If
'Si la fecha es mayor que la fecha actual, activamos mensaje y salimos el cálculo
If CDate(.TextBox1.Value) > Date Then
MsgBox ("LA FECHA NO PUEDE SER MAYOR QUE EL DÍA ACTUAL"), vbExclamation, "CONTROL"
Exit Sub
Exit Sub
End If
'Indicamos la fecha de hoy con formato mm/dd/aaaa y lo componemos en un string
hoy = (Month(Date) & "/" & Day(Date) & "/" & Year(Date))
'Indicamos la fecha de hoy con formato mm/dd/aaaa y lo componemos en un string
f_nac = (Month(.TextBox1.Value) & "/" & Day(.TextBox1.Value) & "/" & Year(.TextBox1.Value))
'Evaluamos la función Datedif para año, mes y día
año = Evaluate("DATEDIF(""" & f_nac & """,""" & hoy & """,""Y"")")
mes = Evaluate("DATEDIF(""" & f_nac & """,""" & hoy & """,""YM"")")
dia = Evaluate("DATEDIF(""" & f_nac & """,""" & hoy & """,""MD"")")
'Pasamos el string con los años, meses y días de nuestra edad actual al textbox2
.TextBox2 = año & IIf(año = 1, " año", " años") & ", " & mes & IIf(mes = 1, " mes", " meses") & " y " & dia & IIf(dia = 1, " dia", " días")
End With
End Sub

Es importante tener en cuenta que la función reconoce la fecha con formato mm/dd/aaaa por lo que debemos especificar esto tanto para la variable que contiene la fecha actual “hoy” como para la que contiene la fecha de nacimiento “f_nac”. Esto lo podemos solucionar componiendo un string con la fecha en el orden indicado.

En el cuadro de texto de la fecha de nacimiento el formato es el habitual: días, meses y años. Si necesitáis introducir los datos con otro formato, tendréis que modificar la macro en los dos string creados para que la función lea adecuadamente la información.

Luego debemos adaptar la función para trabajar con variables y evaluarla con el método Evaluate. Importante el uso de las comillas.

El resultado es el siguiente (calculado sábado 22 de Julio de 2017 a las 23:22 horas):

CALCULAR LA EDAD EN UN FORMULARIO1

Y el resultado es el correcto (y también lo es que me voy haciendo más viejo). El formulario me muestra información completa de la edad que tengo en el momento de ejecutar el código.

He incluido en la macro varios controles: si no existe fecha, si la fecha está mal escrita o si es mayor que el día actual. Si sucede alguna de estas cosas, mostrará un mensaje y proceso finalizará.

Según configuraciones regionales las fechas tendrán formatos distintos, sin embargo, creo que adaptando la macro a meses, días y años funcionará en todos los lugares (siempre que escribamos la fecha de nacimiento con día, mes y año.

Pues esto ha sido todo, espero que os sea de utilidad a la hora de crear formularios o de poner en práctica la función Datedif en VBA.

Descarga el archivo de ejemplo pulsando en: CALCULAR LA EDAD EN UN FORMULARIO DE EXCEL

 

Anuncios

REALIZAR BUCLES ANIDADOS Y BUSCAR VALORES APROXIMADOS

Hola a todos 🙂

Siguiendo con una consulta recibida el fin de semana pasado, un lector solicitaba una macro que recorriese varias columnas y otro bucle anidado que recorriese las celdas de cada columna. A su vez preguntaba la forma de detectar un importe determinado y las aproximaciones según un rango establecido.

Aunque ya existen en la web algunas macros que realizar este trabajo en parte (realizando algunas modificaciones), creo que puede ser interesante compartir con vosotros un nuevo desarrollo.

Para ejemplificar el ejercicio, imaginad que tenéis una tabla varias columnas identificadas con los meses del año, y en cada columna una serie de importes (podéis poner la moneda que queráis, yo lo he dejado con euros):

REALIZAR BUCLES ANIDADOS Y BUSCAR VALORES APROXIMADOS

Pues bien, necesitamos una macro que nos busque un importe determinado que vamos a colocar en la celda “N2” en el campo denominado IMPORTE y además que detecte aquellos valores que se aproximen a ese número según un rango que establezcamos en la celda “O2” en el campo denominado “APROX”.

Para este ejemplo vamos a buscar aquellas celdas que sean igual a 50.000 euros y con aproximaciones de 5.000 euros.

Es decir, debemos marcar además de los 50.000 euros (Rojo), cualquier cifra hasta los 55.000 euros (Verde) y cualquier cifra hasta los 45.000 euros (Azul).

Para ello vamos a usar esta macro que he programado con la que realizaremos el trabajo que nos han pedido:

Sub BUSCAR_VALORES_APROXIMADOS()
'Definimos variables
Dim i As Integer
Dim nNUM As Double
Dim sVAR As Double
'Desactivamos actualizacion de pantalla
Application.ScreenUpdating = False
'Hacemos referencia a la Hoja1 para los cálculos
With Sheets("Hoja1")
'Eliminamos colores de relleno anteriores
.Range("A2", Range("A2").End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Interior.Pattern = xlNone
'Incluimos en las variables cifra a buscar y aproximaciones
nNUM = .Range("N2")
sVAR = .Cells(2, 15)
'Determinamos cuantas columnas tenemos (datos consecutivos)
Fin = Application.CountA(.Range("A1", Range("A1").End(xlToRight)))
'Iniciamos primer bucle por columnas
For i = 1 To Fin
'Determinamos el rango de cada columnas, desde la celda 1 hasta el final con datos
Final = Application.CountA(.Range(Cells(1, i), Cells(1, i).End(xlDown)))
'Iniciamos segundo bucle por celda en cada columna
For j = 2 To Final
'Si el valor de la celda es igual a nNUM marcamos en rojo
If .Cells(j, i) = nNUM Then
.Cells(j, i).Interior.Color = vbRed
'Si el valor de la celda esta entre nNUM y la aproximación en "positivo" marcamos en verde
ElseIf .Cells(j, i) <= nNUM + sVAR And .Cells(j, i) > nNUM Then
.Cells(j, i).Interior.Color = RGB(51, 204, 51)
'Si el valor de la celda esta entre nNUM y la aproximación en "negativo" marcamos en azul
ElseIf .Cells(j, i) >= nNUM - sVAR And .Cells(j, i) < nNUM Then
.Cells(j, i).Interior.Color = RGB(60, 144, 246)
End If
Next
Next
.Range("N2").Select
End With
Application.ScreenUpdating = True
End Sub

Como podéis ver, según vais leyendo los comentarios de la macro, mediante dos bucles, uno de ellos anidado, vamos buscando por cada celda según la columna seleccionada los valores que hemos indicado en el condicional.

Esto nos permitirá modificar las condiciones y los parámetros para adaptar el código a nuestras necesidades.

El resultado que se muestra es este:

REALIZAR BUCLES ANIDADOS Y BUSCAR VALORES APROXIMADOS1

Para este ejercicio he utilizado un loop for – next, pero se podría realizar con otros tipos de bucle y otros métodos de búsqueda, por ejemplo con el método Range.Find, etc.Pero creo que esta forma es más adecuada según los parámetros de la consulta.

Es interesante su uso en aplicaciones o informes con grandes cantidades de información y en el que necesitemos resaltar, extraer o modificar valores determinados.

Descarga el archivo de ejemplo pulsando en: REALIZAR BUCLES ANIDADOS Y BUSCAR VALORES APROXIMADOS

 

ALGUNAS FÓRMULAS PARA CONFECCIONAR NUESTROS INFORMES EN EXCEL

Hola a todos:

En muchas de las consultas que recibo, un tema recurrente es el de la confección de informes. Normalmente siempre preguntas y referencias a las tablas dinámicas (campos calculados, orden de etiquetas, etc…).

Y es que realmente la función de las tablas dinámicas es esa: mostrar información dinámica en la confección informes.

Sin embargo, una buen alternativa a las tablas dinámicas es hacer nuestro informe utilizando fórmulas y siempre con la ventaja de que no vamos a depender de las limitaciones típicas de las tablas dinámicas (colocación de información, límites, etc).

Por ello, en el post de hoy me gustaría trabajar con algunas funciones que nos van a permitir realizar interesantes informes y sin necesidad de usar tablas dinámicas.

Utilizaremos una de las bases de datos que uso habitualmente como ejemplo, una plantilla ficticia de unos grandes almacenes (si quereis saber cómo he generado los nombres, podeís visitar este post: COMBINAR LA FUNCIÓN HALLAR Y LA FUNCIÓN LARGO)

Imaginad que tenemos esta base de datos:

ALGUNAS FORMULAS PARA CONFECCIONAR NUESTROS INFORMES EN EXCEL

Y necesitamos utilizar las fórmulas adecuadas para completar los datos de este informe (que ahora está vacío):

ALGUNAS FORMULAS PARA CONFECCIONAR NUESTROS INFORMES EN EXCEL_1

Para los campos de Sexo, Idioma y Estudios necesitamos funciones que cuenten y a su vez que admitan varios criterios de condición.

Para el campo de la edad necesitamos funciones que puedan obtener promedios, máximos y mínimos.

He creado cuatro hojas con el mismo informe, en cada una trabajaremos una fórmula distinta para contar.

En la hoja INFORME_SUMAPRODUCTO utilizaremos la función SUMAPRODUCTO, la cual vamos a modificar para que cuente los datos que necesitamos. Por ejemplo el número de Hombres en la sección de Deportes:

Solo tenemos que seleccionar un rango de la columna “C” (SECCION) de la Hoja BBDD y que sea igual a la celda A3 de nuestro informe (Deportes) e introducimos un segundo criterio, seleccionando la columna E de la hoja BBDD (SEXO) y la celda B2 de nuestro informe (Hombre).

=SUMAPRODUCTO((BBDD!$C$2:$C$65000=A3)*1;(BBDD!$E$2:$E$65000=$B$2)*1)

Para el resto de campos va a ser igual, excepto en IDIOMA (OTROS), donde debemos especificar que el idioma debe ser diferente de INGLES, FRANCES Y ALEMAN:

=SUMAPRODUCTO((BBDD!$C$2:$C$65000=A3)*1;(BBDD!$F$2:$F$65000<>$E$2)*1;(BBDD!$F$2:$F$65000<>$F$2)*1;(BBDD!$F$2:$F$65000<>$D$2)*1)

Como podéis observar, vamos introduciendo las condiciones de forma anidada y vinculando con el idioma que queremos excluir del proceso de contar empleados.

En la hoja INFORME_CONTAR.SI.CONJUNTO utilizaremos la función CONTAR.SI.CONJUNTO, presente desde Excel 2007 y es una buena opción para contar los elementos de nuestro informe. Siguiendo el ejemplo anterior (número de Hombres en la sección de Deportes) sería así:

=CONTAR.SI.CONJUNTO(BBDD!$C$2:$C$65000;A3;BBDD!$E$2:$E$65000;$B$2)

En la sintaxis seleccionamos rango de la columna SECCIÓN de la hoja BBDD y que sea igual a A3 y también seleccionamos la columna SEXO y que sea igual a B2 (Hombre).

Para el resto de campos va a ser igual, excepto en el IDIOMA (OTROS) donde usaremos la misma fórmula pero indicando los idiomas que no queremos que se tengan en cuenta:

=CONTAR.SI.CONJUNTO(BBDD!$C$2:$C$65000;A3;BBDD!$F$2:$F$65000;”<>” & $E$2;BBDD!$F$2:$F$65000;”<>” & $F$2;BBDD!$F$2:$F$65000;”<>” & $D$2)

Efectivamente usamos las clausulas <> para indicar que cuente aquellos que sea distintos de INGLES, FRANCES Y ALEMAN.

Pues bien, con cualquiera de estas fórmulas podríais realizar el informe perfectamente. Pero me gustaría dejaros otras dos fórmulas (matriciales) para realizar el mismo proceso:

En la hoja INFORME_MATRICIAL utilizaremos una matricial muy sencilla que realiza prácticamente el mismo trabajo que SUMAPRODUCTO (pero en matricial).

Usamos el mismo ejemplo que el de las fórmulas anteriores: Número de hombres en la sección “Deportes”:

{=SUMA((BBDD!$C$2:$C$65000=A3)*(BBDD!$E$2:$E$65000=$B$2))}

Y el resultado será el mismo que en las fórmulas anteriores, es decir 7.

El resto de campos será igual pero cambiando los parámetros, excepto en IDIOMA (OTROS), aquí tendremos que ampliar la fórmulas con más criterios:

{=SUMA((BBDD!$C$2:$C$65000=A3)*(BBDD!$F$2:$F$65000<>$E$2)*(BBDD!$F$2:$F$65000<>$F$2)*(BBDD!$F$2:$F$65000<>$D$2))}

Indicando qué idioma no queremos contar. Esta matricial, me parece muy sencilla y a la vez efectiva, es una de mis favoritas 🙂

En la hoja INFORME_MATRICIAL_2 utilizaremos otra matricial pero en la que usaremos la función CONTAR.

Para el cálculo del número de hombres en la sección “Deportes”, sería así:

{=CONTAR(SI((BBDD!$C$2:$C$65000=A3);SI(BBDD!$E$2:$E$65000=$B$2;BBDD!$A$2:$A$65000)))}

Sin embargo, esta fórmula tiene una peculiaridad, solo va a contar si el rango sobre el que se cuenta es numérico, en nuestro ejemplo podríamos hacer referencia a la columna A o a la D, en nuestro caso, he marcado la A en rojo en la fórmula. Por ello no la podréis usar si vuestra base de datos no tiene una columna con datos numéricos, tipo edad, ID, etc.

Para el contar las celdas de IDIOMA (OTROS), tendremos que incluir los criterios en la función, así:

{=CONTAR(SI((BBDD!$C$2:$C$65000=A3);SI(BBDD!$F$2:$F$65000<>$E$2;SI(BBDD!$F$2:$F$65000<>$F$2;SI(BBDD!$F$2:$F$65000<>$D$2;BBDD!$A$2:$A$65000)))))}

Y el resultado es el mismo para todos los casos:

ALGUNAS FORMULAS PARA CONFECCIONAR NUESTROS INFORMES EN EXCEL_2

Aunque no era el objeto de este post, os he incluido tres fórmulas más (matriciales) para calcular el promedio, el máximo y el mínimo de la edad por cada sección.

Para calcular el Promedio:

{=REDONDEAR(PROMEDIO(SI(BBDD!$C$2:$C$65000=A3;BBDD!$D$2:$D$65000));0)}

y usamos la función redondear para eliminar todos los decimales (podríamos usar entero).

Para el cálculo de Max:

{=REDONDEAR(MAX(SI(BBDD!$C$2:$C$65000=A3;BBDD!$D$2:$D$65000));0)}

Para el cálculo de Min:

{=REDONDEAR(MIN(SI(BBDD!$C$2:$C$65000=A3;BBDD!$D$2:$D$65000));0)}

El resultado es este (el mismo para las cuatro pestañas):

ALGUNAS FORMULAS PARA CONFECCIONAR NUESTROS INFORMES EN EXCEL_3

Y las cuatro pestañas tienen que mostrar la misma información.

ALGUNAS FORMULAS PARA CONFECCIONAR NUESTROS INFORMES EN EXCEL_4

Hemos utilizado fórmulas distintas para contar numero de empleados por sección o departamento, según sexo, idioma o estudios. Y también hemos calculado algunos estadísticos para enriquecer la información.

Os recuerdo que las matrices se introducen: seleccionando la celda que contiene la fórmula, pulsando en F2 , seleccionamos la fórmula y luego presionamos CTRL + MAYUS + ENTRAR

Descarga el archivo de ejemplo pulsando enALGUNAS FÓRMULAS PARA CONFECCIONAR NUESTROS INFORMES EN EXCEL

 

COMPROBAR SI EXISTEN ERRORES EN LAS FORMULAS DE NUESTRO ARCHIVO CON VBA

Hola a todos!

Espero que estéis bien 🙂

En el post de hoy voy a tratar el tema de los errores en fórmulas y cómo podemos detectarlos utilizando VBA.

Una forma de hacer esto sin recurrir a macros, es entrando en la ficha Inicio > “Ir a Especial” y seleccionar “Celdas con fórmulas” (aunque no las marcará):

COMPROBAR SI EXISTEN ERRORES EN LAS FORMULAS DE NUESTRO ARCHIVO CON VBA

O utilizando la ficha formato condicional que permite verificar y marcar cualquier error en el rango indicado:

COMPROBAR SI EXISTEN ERRORES EN LAS FORMULAS DE NUESTRO ARCHIVO CON VBA2

Pero siempre está bien crear nuevas alternativas que agilicen nuestros procesos, para este caso implementaré una macro que verifique en cada hoja si existen errores y en caso afirmativo, pinte de rojo la celda y muestre un mensaje de advertencia indicando que existen errores.

Como en el post anterior traté el tema de los métodos de depreciación, y el archivo tiene bastantes fórmulas nos servirá de ejemplo.

Para ello voy a crear cuatro pestañas con el mismo archivo, pero introduciendo errores en las fórmulas para luego detectarlos, en cada hoja introduciré un error distinto para comprobar que la macro funciona correctamente.

Y a continuación ejecuto el siguiente código:

Sub BUSCAR_ERRORES()
'Declaramos variables
Dim i As Integer, nHoja As Integer, X As Integer
'Contamos las hojas que tenemos en nuestros libro
nHoja = ActiveWorkbook.Worksheets.Count
'Iniciamos un loop para recorrer todas las hojas
For i = 1 To nHoja
Sheets(i).Select
Range("A1").Select
'Detectamos si existen errores en las hojas y marcamos celdas en rojo
'Controlamos error que se muestra si no existen formulas con errores
On Error Resume Next
Selection.SpecialCells(xlCellTypeFormulas, 16).Select
If Err.Number <> "1004" Then
X = X + 1
Selection.Interior.Color = vbRed
End If
On Error GoTo 0
Next
'Mostramos mensaje informativo o de advertencia
If X > 0 Then
MsgBox ("REVISA EL ARCHIVO, EXISTEN ERRORES"), vbExclamation, "INFORME"
Else
MsgBox ("ARCHIVO SIN ERRORES"), vbInformation, "INFORME"
End If
End Sub

El resultado es el siguiente:

Hoja1:

COMPROBAR SI EXISTEN ERRORES EN LAS FORMULAS DE NUESTRO ARCHIVO CON VBA3

Hoja2:

COMPROBAR SI EXISTEN ERRORES EN LAS FORMULAS DE NUESTRO ARCHIVO CON VBA4

Hoja3:

COMPROBAR SI EXISTEN ERRORES EN LAS FORMULAS DE NUESTRO ARCHIVO CON VBA5

Y en la hoja4 no hay nada marcado porque no existen errores:

COMPROBAR SI EXISTEN ERRORES EN LAS FORMULAS DE NUESTRO ARCHIVO CON VBA6

Esta macro tiene la ventaja de ser muy rápida y que la podemos aplicar de una vez a todo el libro. Sin duda resulta de gran ayuda para evitar equivocaciones en nuestros cálculos!.

Espero que os resulte útil, no cuesta nada pegar la macro en un módulo estándar y ejecutarla 🙂

Descarga el archivo de ejemplo pulsando en: COMPROBAR SI EXISTEN ERRORES EN LAS FÓRMULAS DE NUESTROS ARCHIVOS CON VBA

CÁLCULO DE DEPRECIACIONES CON EXCEL

Hola a todos 🙂

Para el post de hoy no voy a utilizar programación, ni macros ni VBA. Hoy vamos a trabajar solo con fórmulas. ¿y sobre qué tema trataremos hoy?, pues sobre algo que ya me han pedido más e una vez y que no he tenido tiempo de implementar y preparar para una publicación, el cálculo de las depreciaciones con las funciones programadas en Excel.

En Excel contamos con varias funciones para calcular la depreciación de un bien, cada una con su tipo de cálculo y su utilidad.

Para ilustrar el ejercicio e ir mostrando cada función, podré un ejemplo. Imaginad que os habéis comprado un coche y que os habéis gastado 70.000 euros, evidentemente es un gran coche, deportivo, con buenos acabados, asientos de cuero, muchos caballos de potencia, etc.  Y queremos calcular la depreciación de ese bien, según unos parámetros que vamos a ir indicando y modificando.

Como parámetros generales para todas las fórmulas, serán:

  • Coste del bien: 70.000 euros.
  • Valor residual: 10.000 euros.
  • Vida útil: 10 años.

Pues bien comenzaremos con la primera:

Función SLN o Método de Depreciación Directo: Devuelve la depreciación por método directo de un bien en un período dado.

Los elementos que debemos tener en cuenta en su sintaxis son el coste del bien, el valor residual, y la vida útil. El resultado nos dará una columna con el mismo importe, es decir, 6.000 euros. Y si queremos obtener como va descendiendo el valor por cada periodo solo tenemos que restarlo al valor anterior.

Más información en: Función SLN

El resultado es este:

CaLCULO DE DEPRECIACIONES CON EXCEL

Función SYD o Método de Depreciación por Anualidades: Devuelve la depreciación por suma de dígitos de los años de un bien durante un período específico.

Los elementos que debemos tener en cuenta en su sintaxis son el coste del bien, el valor residual, la vida útil y el periodo en el que nos encontramos, (siempre empezaremos por 1, el cero se utiliza en otra función que veremos más adelante).

Más información en: Función SYD

El resultado es el siguiente:

CaLCULO DE DEPRECIACIONES CON EXCEL2

 

Función DB o Método de Depreciación por Saldo Fijo: Devuelve la depreciación de un bien durante un período específico usando el método de depreciación de saldo fijo.

Los elementos que debemos tener en cuenta en su sintaxis son el coste del bien, el valor residual, la vida útil y el periodo en el que nos encontramos, (siempre empezaremos por 1, el cero se utiliza en otra función que veremos más adelante) y el mes (que es el número de meses del primer año, si lo omitimos tomará como referencia el 12).

Más información en: Función DB

El resultado es el siguiente:

CALCULO DE DEPRECIACIONES CON EXCEL4

 

Función DDB o Método de Depreciación por doble disminución de saldo Devuelve la depreciación de un activo en un período específico con el método de depreciación por doble disminución de saldo u otro método que se especifique.

Los elementos que debemos tener en cuenta en su sintaxis son el coste del bien, el valor residual, la vida útil y el periodo en el que nos encontramos, (siempre empezaremos por 1, el cero se utiliza en otra función que veremos en la siguiente función) y el factor: que es la tasa de depreciación del saldo. Si omite este valor, se supone automáticamente que es 2 (el método de depreciación por doble disminución de saldo).

Más información en: Función DDB

El resultado es el siguiente:

CALCULO DE DEPRECIACIONES CON EXCEL5

 

Función DVS o Método de Depreciación por doble disminución de saldo Devuelve la depreciación de un bien durante un período especificado, inclusive un período parcial, usando el método de disminución doble del saldo o cualquier otro que especifique y según el coeficiente que usted decida. Las iniciales DVS corresponden a disminución variable del saldo.

Los elementos que debemos tener en cuenta en su sintaxis son el coste del bien, el valor residual, la vida útil, el periodo que queremos calcular (inicial y final) el primer periodo será cero, y el factor (que ya lo explicamos en la función anterior).

Más información en: Función DVS

El resultado es el siguiente (en este ejemplo obtengo en el periodo 6 el resultado acumulado hasta el periodo 10).

CALCULO DE DEPRECIACIONES CON EXCEL6
Y una vez que ya tenemos todas las variantes calculadas, hemos acabado el ejercicio. Aquí os dejo el resultado de todos los cálculos.

No he incluido ninguna automatización ni macros, es cálculo puro y aplicación de funciones. Si necesitáis ampliar periodos debéis incluirlos en le rango y aplicar las fórmulas.

Por cierto, que rápido pierden valor algunos objetos …al contrario de otros, que supongo que la función en lugar de depreciar debería reevaluar el objeto, por ejemplo, el arte.

CALCULO DE DEPRECIACIONES CON EXCEL7

 

Descarga el archivo de ejemplo pulsando en: CÁLCULO DE DEPRECIACIONES CON EXCEL

EXTRAER DATOS DE UNA CADENA DE TEXTO DE DOS EN DOS O MÁS CARACTERES

Hola a todos:

Hace unos días me llegó una consulta donde solicitaban extraer información de una cadena de datos. Sobre esta temática hay varios post dedicados en la web 🙂

Aquí lo que me pedían era el modo de extraer datos de dos en dos y pasarlos a columnas contiguas. Es un trabajo sencillo pero requiere modificar la macro desarrollada en este post: EXTRAER INFORMACIÓN ESPECÍFICA DE UNA CADENA ALFANUMÉRICA UTILIZANDO TEXTO EN COLUMNAS

Realmente lo que vamos a necesitar es fragmentar esa cadena de datos de dos en dos y con un espacio entre cada par de números, para luego utilizar texto en columnas y separar por espacios.

Pues bien, vamos a utilizar este ejemplo:

EXTRAER DATOS DE UNA CADENA DE TEXTO DE DOS EN DOS O MAS CARACTERES

en este caso trabajamos con datos numéricos y formato numérico, pero funciona perfectamente para texto. Y utilizaremos la siguiente macro:

Sub Extrae_n_caracteres()
'Definimos variables
Dim i As Integer, j As Integer, n As Integer, fin As Integer
Dim nCampos As Integer, n_Colum As Integer
Dim miCelda As String, sCadena As String, nPar As String
Dim miArray As Variant, iArray As Variant
'Iniciamos la macro
With Sheets("DATOS")
Application.ScreenUpdating = False
fin = Application.CountA(.Range("A:A"))
'Borramos información a partir de la columna "B"
.Range(.Cells(2, 2), ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
'Iniciamos bucle para recorrar todas las filas
For j = 2 To fin
sCadena = vbNullString
miCelda = .Cells(j, 1)
'Vaciamos variable scadena
For i = 1 To Len(miCelda) Step 2
'Extraemos de 2 en 2
nPar = Mid(miCelda, i, 2)
'Añadimos un espacio cada dos números
sCadena = sCadena & " " & nPar
Next
'Eliminamos espacios al principio y final
miCelda = Trim(sCadena)
'Pasamos la cadena a la segunda columna
.Cells(j, 2) = Trim(sCadena)
'Dimensionamos matrices con los datos que tenemos en miCelda
'para determinar las columnas de la función textToColumns
nCampos = Len(.Cells(j, 2))
nCampos = nCampos - 1
ReDim miArray(0 To nCampos)
For n_Colum = 0 To nCampos
ReDim iArray(0 To 1)
iArray(0) = n_Colum + 1
iArray(1) = 2
miArray(n_Colum) = iArray
Next n_Colum
'Aplicamos la función texto en columnas a partir de la segunda columna
'delimitamos el texto en caracteres (en este ejemplo utilizamos los espacios).
Cells(j, 2).TextToColumns Destination:=Range("B" & j), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Space:=True, FieldInfo:=miArray
'Indicamos que todas las matrices tengan formato general, pero podríamos indicar que sea número, etc
Next
.Cells(j, 1).Select
End With
End Sub

El resultado será el siguiente:

EXTRAER DATOS DE UNA CADENA DE TEXTO DE DOS EN DOS O MAS CARACTERES2

Podríamos modificar los parámetros para extraer de tres en tres: modificando los parámetros de la macro (en rojo)

For i = 1 To Len(miCelda) Step 3
'Extraemos de 3 en 3
nPar = Mid(miCelda, i, 3)
'Añadimos un espacio cada tres números
sCadena = sCadena & " " & nPar
Next

EXTRAER DATOS DE UNA CADENA DE TEXTO DE DOS EN DOS O MAS CARACTERES3

o de cuatro en cuatro:

For i = 1 To Len(miCelda) Step 4
'Extraemos de 4 en 4
nPar = Mid(miCelda, i, 4)
'Añadimos un espacio cada tres números
sCadena = sCadena & " " & nPar
Next

EXTRAER DATOS DE UNA CADENA DE TEXTO DE DOS EN DOS O MAS CARACTERES4

Incluso podríamos extraer cada n posiciones repitiendo el último número del fragmento anterior:

For i = 1 To Len(miCelda) Step 1
'Extraemos de 2 en 2 y añadiendo en número del fragmento anterior
nPar = Mid(miCelda, i, 2)
'Añadimos un espacio cada dos números
sCadena = sCadena & " " & nPar
Next

EXTRAER DATOS DE UNA CADENA DE TEXTO DE DOS EN DOS O MAS CARACTERES5

Y este ha sido el resultado de la consulta, que le sirvió a nuestro lector perfectamente para seguir con su proyecto 🙂

Espero que os sea de utilidad también a vosotros.

Descarga el archivo de ejemplo pulsando en: EXTRAER DATOS DE UNA CADENA DE TEXTO DE DOS EN DOS O MAS CARACTERES

 

GENERANDO UN ALGORITMO GENÉTICO EN VBA

Hola a todos 🙂

Espero que estéis bien! Además dadas las fechas en las que estamos, seguro que algunos de vosotros ya estaréis empezando las vacaciones!.

En el post de hoy vamos a tratar un tema que está bastante de moda, los algoritmos evolutivos y dentro de estos, los algoritmos genéticos.

Dentro de los algoritmos genéticos existen multitud de tipos de cálculo y técnicas para obtener una simulación de cruce genético, es decir de creación y combinación de cadenas de ADN tras cada generación.

Dado que esto es un proceso, lo podemos programar en VBA (al igual que en otros muchos lenguajes de programación).

En la red hay muchos ejemplos de programación, de mayor o menor complejidad, pero que en esencia realizan los mismos pasos:

  • Generación del material a tratar (cromosomas).
  •  Elección del % de material óptimo (cromosomas más aptos), según criterio seleccionado.
  •  Cruce del los cromosomas óptimos, según criterio seleccionado.
  •  Generación de nuevos cromosomas.
  •  Repetición del proceso tantas veces por generaciones que se quieran establecer.

A partir de aquí, debemos utilizar las técnicas y procedimientos de programación que mejor se ajusten a nuestro proyecto.

Como sabéis, cuando realizo un post, me gusta explicarlo bien. Que todo lector con curiosidad pueda comprender y realizar los mismos ejercicios que se proponen, es la fisolofía de esta web. Por ello, trataré de ser lo más claro posible y también de utilizar funciones y procedimientos claros en el código. Esto lo comento porque muchos de los ejemplos que circulan por la red además de ser bastante complejos, el código utilizado es dificil de seguir y comprender.

Una vez realizada esta introducción, vamos a empezar con el ejercicio paso por paso.

La situación de partida propuesta es que queremos generar X número de cromosomas con una longitud determinada y que contará con números aleatorios comprendidos del 1 al 9 (he excluido el cero para no tener que estar formateando celdas con formato texto).

Nuestro archivo Excel tendrá dos pestañas, una la llamaremos MATRIZ y otra REPORT. En la hoja MATRIZ realizaremos todos los cálculos y en REPORT mostraremos detalle de los resultados.

Contaremos con cuatro módulos, aunque el módulo principar se llama INICIAL, aquí vamos a incluir el siguiente código, que incluirá llamadas a las otras tres macros. Os muestro este código y lo vamos comentando paso a paso:

Sub MODELO_ALGORITMO_GENETICO()
'Declaramos variables
Dim Min As Integer, Max As Integer, GEN As String, GENOTIPO As String
Dim COMBO As Integer
Dim i As Integer, n As Integer, b As Integer, j As Integer
'Limpiamos hoja REPORT
Sheets("REPORT").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
'Limpiamos rango de cálculos en MATRIZ
Sheets("MATRIZ").Select
With Sheets("MATRIZ")
pTotal = Application.CountA(Range("A:A"))
If pTotal > 1 Then .Range("A2:E" & pTotal).Clear
'Generamos lista consecutiva de casos
.Cells(1, 1) = "Nº DE CASOS"
For i = 2 To .Cells(2, 10) + 1
.Cells(i, 1) = i - 1
Next
'Creamos individuos
pTotal = Application.CountA(Range("A:A"))
.Cells(1, 2) = "POBLACIÓN INICIAL"
For i = 2 To pTotal
Min = 1
Max = 9
GEN = vbNullString
For n = 1 To .Cells(2, 11)
COMBO = Application.WorksheetFunction.RandBetween(Min, Max)
GEN = COMBO & GEN
Next n
Cells(i, 2) = GEN
Next i
'Creamos genotipo a comparar
.Cells(1, 7) = "GENOTIPO"
GENOTIPO = vbNullString
For n = 1 To .Cells(2, 11)
COMBO = Application.WorksheetFunction.RandBetween(Min, Max)
GENOTIPO = COMBO & GENOTIPO
Next n
Cells(2, 7) = GENOTIPO
'Iniciamos bucle por cada generación
For b = 1 To .Cells(2, 8)
If b > 1 Then
For j = 2 To pTotal
.Cells(j, 2) = .Cells(j, 5)
Next j
End If
'Llamamos al resto de macros para generar la información
Call CALIFICACIONES
Call APTOS
Call N_POBLACION
'Generamos informe resumen en la hoja REPORT
For i = 2 To pTotal
With Sheets("REPORT")
.Cells(i, 1) = Worksheets(1).Cells(i, 1)
.Cells(1, b + 1) = b & "ª" & " " & "GENERACION"
.Cells(i, b + 1) = Worksheets(1).Cells(i, 5)
.Cells(1, 1) = "Nº CASOS"
End With
Next i
Next b
End With
End Sub

Cuando lo ejecutemos, lo primero que va a hacer es limpiar de contenidos la parte del cálculo de la hoja MATRIZ y la hoja REPORT.

A continuación, generamos lista ordenada de número de casos para la muestra:

'Generamos lista consecutiva de casos
With Sheets("MATRIZ")
pTotal = Application.CountA(Range("A:A"))
If pTotal > 1 Then .Range("A2:E" & pTotal).Clear
'Generamos lista consecutiva de casos
.Cells(1, 1) = "Nº DE CASOS"
For i = 2 To .Cells(2, 10) + 1
.Cells(i, 1) = i - 1
Next

En nuestra hoja Matriz crearemos un campo para determinar el rango máximo de casos (.Cells(2, 10)+1) en este ejemplo será 10:

El resultado es este:

GENERANDO UN ALGORITMO GENETICO EN VBA

A continuación debemos crear nuestra población de cromosomas, teniendo en cuenta que su longitud será de 10 posiciones con números aleatorios del 1 al 9:

'Creamos individuos
pTotal = Application.CountA(Range("A:A"))
.Cells(1, 2) = "POBLACIÓN INICIAL"
For i = 2 To pTotal
Min = 1
Max = 9
GEN = vbNullString
For n = 1 To .Cells(2, 11)
COMBO = Application.WorksheetFunction.RandBetween(Min, Max)
GEN = COMBO & GEN
Next n
Cells(i, 2) = GEN
Next i

Este es el resultado:

GENERANDO UN ALGORITMO GENETICO EN VBA1

El siguiente paso, será el de crear el GENOTIPO, o gen modelo con el que vamos a comparar el resto de genes:

'Creamos genotipo a comparar
.Cells(1, 7) = "GENOTIPO"
GENOTIPO = vbNullString
For n = 1 To .Cells(2, 11)
COMBO = Application.WorksheetFunction.RandBetween(Min, Max)
GENOTIPO = COMBO & GENOTIPO
Next n
Cells(2, 7) = GENOTIPO

Y con esto ya tenemos los elementos necesarios para iniciar el cálculo:

GENERANDO UN ALGORITMO GENETICO EN VBA2

El siguiente paso, será generar un loop que repita el proceso tantas veces como lo hayamos indicado en la celda (2,8) de la hoja MATRIZ y a través del cual generemos el resto de macros

'Iniciamos bucle por cada generación
For b = 1 To .Cells(2, 8)
If b > 1 Then
For j = 2 To pTotal
.Cells(j, 2) = .Cells(j, 5)
Next j
End If
'Llamamos al resto de macros para generar la informacion
Call CALIFICACIONES
Call APTOS
Call N_POBLACION

En la primera de las macros, vamos a otorgar puntuación a cada uno de los cromosomas, esto lo vamos a hacer, contanto las veces que un número del genotipo se repite en un cromosoma, a más repeticiones, mayor calificación y por lo tanto más apto, esta es la macro:

Sub CALIFICACIONES()
'Declaramos variables
Dim pTotal As Integer, j As Integer, GEN As Integer
Dim apto As Integer, r As Integer, i As Integer
With Sheets("MATRIZ")
pTotal = Application.CountA(.Range("A:A"))
'Contamos las veces que se repite cada número de cada cromosoma con los números del genotipo de comparación
.Cells(1, 4) = "SELECCION"
For j = 2 To pTotal
apto = 0
For r = Len(.Cells(2, 7)) To 1 Step -1
GEN = Mid(.Cells(2, 7), r, 1)
For i = Len(.Cells(j, 2)) To 1 Step -1
If Mid(.Cells(j, 2), i, 1) = GEN Then
apto = apto + 1
End If
Next i
Next r
'Mostramos resultado
.Cells(j, 3) = apto
Next j
End With
End Sub

y este es el resultado:

GENERANDO UN ALGORITMO GENETICO EN VBA3

El siguiente paso es llamar a la macro APTOS que se encuentra en el módulo FITNESS, para seleccionar el % de mejores genes que hemos indicado en la hoja MATRIZ, ordenando de forma descendente y seleccionando los “n” primeros casos.

Sub APTOS()
'Declaramos variables
Dim apto As Integer, pTotal As Integer
Dim j As Integer, rRango As Range, cCell As Variant
'Ordenamos la columna C descendente
With Sheets("MATRIZ")
pTotal = Application.CountA(Range("A:A"))
If pTotal > 1 Then .Range("D2:D" & pTotal).Clear
'elegimos a los n más aptos según % de seleccion
apto = Int((pTotal - 1) * .Cells(2, 9))
.Cells(1, 3) = "FITNESS"
Set rRango = Range("A1:E" & pTotal)
cCell = Range("C1")
rRango.Sort Key1:=cCell, Order1:=xlDescending, Header:=xlYes
For j = 2 To pTotal
If j - 1 <= apto Then
.Cells(j, 4) = .Cells(j, 2)
End If
Next j
'Volvemos a ordenar por la columna A
cCell = Range("A1")
rRango.Sort Key1:=cCell, Order1:=xlAscending, Header:=xlYes
End With
End Sub

Y el resultado es este:

GENERANDO UN ALGORITMO GENETICO EN VBA4

Finalmente, debemos generar una nueva población a partir de esos genes que hemos seleccionado. En este punto, hay muchas variantes y teorías de cómo hacerlo, en este caso, yo he elegido hacerlo de una forma particular aunque siempre podréis adaptarlo a vuestras necesidades o preferencias. Lo que se realiza en este paso es lo siguiente:

Los “n” casos aptos seleccionados los paso a una variable string (todos los cromosomas en una misma linea de datos), luego creo nuevos cromosomas a partir de esa cadena de forma aleatoria, menos el número final del nuevo cromosoma, es decir el número 10 lo vuelvo a elegir de otro subproceso aleatorio de números entre 1 y 9.

Este último paso nos va a ayudar a “regular” la diversidad genética, dado que podemos elegir que se generen números del 1 al 9 pero restringiendo el rango, por ejemplo, entre 1 y 2 o entre 1 y 3 etc … A mayor rango, mayor diversidad y esto permitirá que con cada generación existan más individuos diferentes entre si, esto se regula en NIVEL DE MUTACIÓN de hoja MATRIZ. La macro completa es esta:

Sub N_POBLACION()
'Declaramos variables
Dim scadena As String, x As String
Dim i As Integer, d As Integer, punto As Integer, nGen As Integer
Dim j As Integer, n As Integer, pTotal As Integer
'Seleccionamos los cromosomas más aptos
With Sheets("MATRIZ")
pTotal = Application.CountA(.Range("A:A"))
scadena = vbNullString
.Cells(1, 5) = "NUEVA POBLACIÓN"
'Y los pasamos a una cadena
For j = 2 To pTotal
scadena = scadena & .Cells(j, 4)
Next j
'Utilizamos cada número de la cadena
'para crear una cromosoma nuevo aleatoriamente

For i = 2 To pTotal
x = vbNullString
For n = 1 To Len(scadena)
punto = Application.WorksheetFunction.RandBetween(1, Len(scadena))
nGen = Application.WorksheetFunction.RandBetween(1, .Cells(2, 12))
d = Mid(scadena, punto, 1)
x = x & d
' Generamos un nuevo cromosoma con n-1 caracteres
' y el último lo volvemos a asignar aleatoriamente (nGen)

Q = .Cells(2, 11).Value
If Len(x) = Q - 1 Then Exit For
Next n
.Cells(i, 5) = x & nGen
Next i
End With
End Sub

Y este es el resultado:

GENERANDO UN ALGORITMO GENETICO EN VBA5

Dado que vamos a generar multitud de generaciones en cada cálculo, nos vendrá bien, pasar la información de cada cálculo a la hoja REPORT.Esto lo vamos a conseguir con esta macro situada al final de la macro INICIAL:

'Generamos informe resumen en la hoja REPORT
For i = 2 To pTotal
With Sheets("REPORT")
.Cells(i, 1) = Worksheets(1).Cells(i, 1)
.Cells(1, b + 1) = b & "ª" & " " & "GENERACION"
.Cells(i, b + 1) = Worksheets(1).Cells(i, 5)
.Cells(1, 1) = "Nº CASOS"
End With
Next i

De forma que tengamos un resumen de cada ejecución del programa con todas las generaciones que se han indicado. Y esta es la información resumen:

GENERANDO UN ALGORITMO GENETICO EN VBA7

En el resumen podemos apreciar la evolución de la primera generación hasta la quinta, en este ejemplo, aunque tenemos un nivel de mutación de 9, el % de selección es de 20% y por eso ya en la quinta generación todos los genes son muy parecidos. La clave está en jugar con el % de seleccionados para combinar y el nivel de mutación, cuando más altos más diversidad genética.

Como habéis podido observar, es un post bastante largo y con mucho contenido, útil para analizar el proceso y las técnicas utilizadas, y siempre teniendo en cuenta que esto es un ejemplo sencillo.

Para finalizar, me gustaría comentar sobre los controles de la hoja MATRIZ, aquellas celdas que están en azul son celdas en las que se muestra el cálculo, las celdas en gris son para que indiquéis los datos con los que queréis calcular:

GENERANDO UN ALGORITMO GENETICO EN VBA6

  • GENERACIONES: Son el número de veces que vamos a generar la aplicación. y que corresponden a las generaciones evolutivas de la población inicial.
  • SELECCIÓN: Es el % sobre el total que vamos a seleccionar los más aptos.
  • NÚMERO DE CASOS: Es el rango de casos, grabados de forma consecutiva, 1, 2 ,3 etc.
  • LONGITUD GENÉTICA: El largo o cantidad de números de cada cromosoma.
  • NIVEL MUTACIÓN: Introduce en el cálculo mayor o menor rango de números comprendidos entre 1 y 9. A mayor número mayor diversidad.

Y esto ha sido todo! ha sido un ejercicio completo y muy interesante!

Espero que os haya gustado y os pueda ser de utilidad 🙂

Descarga el archivo de ejemplo pulsando en: GENERANDO UN ALGORITMO GENÉTICO EN VBA