Archivo de la categoría: Macros

FUNCIÓN PARA CONTAR VALORES ÚNICOS EN UN RANGO

Publicado el por

Hola a todos:

Como estoy a punto de comenzar las vacaciones (ya casi puedo oler el mar), hoy voy a escribir un post para despedirme hasta dentro de unos días.

Para el post de hoy voy a utilizar una consulta de un lector como planteamiento:

Sería posible una UDF que permitiera contar distintos. Es decir, una fórmula similar a SUMAR.SI.CONJUNTO pero que contara solo el valor único y no repetidos. Por si no me he explicado del todo bien, las nuevas tablas dinámicas (vinculadas a un modelo de datos) permiten el “recuento distinto”, sería replicar esa posibilidad en una UDF.

Realmente (creo), que lo que se busca es una función que cuente los valores únicos en un rango seleccionado, o lo que es lo mismo, los valores distintos.

Para realizar este ejercicio, lo voy a hacer con datos numéricos, aunque nuestro código siempre tratará la información como un texto, dado que trabajaremos con “string” o cadenas de texto.

Vamos con un ejemplo:

FUNCION PARA CONTAR VALORES UNICOS EN UN RANGO

Aquí tenemos una relación de números no repetidos del 1 al 45, en cada celda un número. Es decir que los valores únicos en este caso son “45”.

Para obtener este dato vamos a utilizar una función que acabo de crear y que llamaré: “CONTARUNICOS”

Este es el código:

Function CONTARUNICOS(ByVal target As Range)
'Declaramos variables
Dim Cuenta As Long, matriz As Variant
Dim Dato As String, celda As Variant
Dim i As Long, oDic As Object
Dim Unicos As String
'Recorremos todas las celdas incluidas en el rango
For Each celda In target
Dato = Dato & " " & celda
Next celda
'Creamos una matriz con la cadena anterior
matriz = Split(Dato, " ")
'Creamos objeto diccionario para seleccionar solo únicos
Set oDic = CreateObject("scripting.dictionary")
For i = 0 To UBound(matriz)
If Not oDic.Exists(matriz(i)) Then oDic.Add matriz(i), matriz(i)
Next i
'Una vez que tenemos string de únicos, contamos espacios en blanco +1
Unicos = Trim(Join(oDic.Keys, " "))
Cuenta = UBound(Split(Unicos, " ")) + 1
'Pasamos el valor a la función
CONTARUNICOS = Cuenta
End Function

Así, el resultado de la función es:

FUNCION PARA CONTAR VALORES UNICOS EN UN RANGO_1

Si tuviésemos, por ejemplo, la columna D con números del 1 al 45, el resultado sería el mismo:

FUNCION PARA CONTAR VALORES UNICOS EN UN RANGO_2

Si incluimos nuevos datos, que no estén repetidos, la función los contará.

Y eso es todo, espero que con esta función haya respondido la duda del lector y os sirva también en vuestros proyectos.

PD: Nos vemos a la vuelta de las vacaciones : )

Descarga el archivo de ejemplo pulsando en: FUNCIÓN PARA CONTAR VALORES ÚNICOS EN UN RANGO

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

Anuncios

SUMAR DATOS EN UN RANGO SEGÚN EL COLOR DE LA CELDA

Publicado el por

Hola a todos:

Estos están siendo los últimos post antes de irme de vacaciones, así que aprovecho cualquier momento para escribir y publicar : )

Bien, hoy vamos a responder a una consulta que realizaba un lector hace unos días:

Buenas: Se pueden sumar celdas que contengan el mismo color de celda (coloreado manualmente)?
Saludos

Pues respondiendo a la consulta, claro que es posible,  y podemos hacerlo con una UDF (una función creada por nosotros mismos).

Veamos el siguiente ejemplo:

SUMAR DATOS EN UN RANGO SEGUN EL COLOR DE LA CELDA

y ahora lo que deseamos obtener es la suma del acumulado de cada color. Para ello, utilizaremos la siguiente función:

Function SUMACOLOR(ByVal rango As Range, miColor As Range)
'Declaramos variables
Dim Celda As Variant, cColor As String, nColor As Variant
Dim nRango As String, dato As Variant
'Detectamos código del color elegido
cColor = miColor.Address
nColor = Range(cColor).Interior.Color
'En el rango seleccionado sumamos el color que previamente hemos elegido
For Each Celda In rango
nRango = Celda.Address
If Range(nRango).Interior.Color = nColor And IsNumeric(Celda) Then dato = dato + Celda
Next Celda
'pasamos el valor a la función
SUMACOLOR = dato
End Function

El resultado es el siguiente:

SUMAR DATOS EN UN RANGO SEGUN EL COLOR DE LA CELDA_1

Como podéis observar, el primer parámetro es el rango sobre el que se desea obtener la suma y el segundo es la celda que contiene el color elegido para sumar.

La macro está programada para sumar solo números de forma que si en una celda con color, aparece un caracter no numérico, no lo tendrá en cuenta.

Y eso es todo!  Ha resultado un función muy sencilla y muy útil!!, espero que os sirva!

*  Importante: Este código no funciona con formato condicional

Descarga el archivo de ejemplo pulsando en: SUMAR DATOS EN UN RANGO SEGÚN EL COLOR DE LA CELDA

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

LISTAR TODOS LOS ARCHIVOS SELECCIONADOS

Publicado el por

Hola a todos:

Hace un tiempo respondí a un lector sobre una duda que me envíaba a raíz de este post: LISTAR TODOS LOS ARCHIVOS DE UNA CARPETA Y SUS SUBCARPETAS CON VBA.

La consulta era la siguiente: “Hola. Gracias por sus aportes. Estoy buscando realizar este proceso, pero NO quiero que el código liste todos archivos de una carpeta, sino que sólo los archivos que seleccione. Me podría ayudar con esto?”

Efectivamente, en el post inicial el proceso se basa en listar todos los archivos que contenga la carpeta seleccionada y sus subcarpetas. Precisamente la problemática del código radica programar el recorrido por las carpetas, y esta consulta que envía el lector resulta mucho más sencilla:

De hecho, el código a utilizar sería este:

Sub LISTAR_ARCHIVOS()
'Definimos variables
Dim i As Long, j As Long
Dim nArchivo As String, dir_Archivo As Variant
'Creamos ventana de diálogo para seleccionar los archivos que queremos listar
dir_Archivo = Application.GetOpenFilename(Title:="SELECCIONA ARCHIVOS PARA CONSOLIDAR", MultiSelect:=True)
'Si no seleccionamos archivos, salimos del proceso
If Not IsArray(dir_Archivo) Then
Exit Sub
End If
With ActiveSheet
'Iniciamos un for con para identificar los archivos seleccionados
If IsArray(dir_Archivo) Then
For j = LBound(dir_Archivo) To UBound(dir_Archivo)
i = Application.CountA(Range("A:A")) + 1
nArchivo = dir_Archivo(j)
'pasamos el link de cada archivo seleccionado a la hoja
.Cells(i, 1).Select
.Hyperlinks.Add Anchor:=Selection, Address:=nArchivo, TextToDisplay:=nArchivo
Next j
End If
End With
End Sub

Solo tendremos que seleccionar los archivos, por ejemplo de una carpeta:

LISTAR TODOS LOS ARCHIVOS SELECCIONADOS

Y la macro hará el resto:

LISTAR TODOS LOS ARCHIVOS SELECCIONADOS_1

Y eso es todo, como podéis ver, la macro es muy sencilla y con los comentarios se puede comprender todo el proceso.

Espero que también a vosotros os resulte interesante (y de utilidad).

Descarga el archivo de ejemplo pulsando en: LISTAR TODOS LOS ARCHIVOS SELECCIONADOS

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

MOSTRAR UN POPUP EN IMAGEN AL MOVER EL CURSOR POR ENCIMA

Publicado el por

Hola a todos:

En el post de hoy vamos a comprobar que es posible crear un “pop up” en una imagen vinculado al movimiento del cursor cuando pasa por encima.

Sobre este asunto no existe muchas alternativas en Excel, dado que las imágenes, formas o iconos no permiten o carecen de eventos como los pop up o información emergente.

Pero existe una forma o técnica que nos puede ayudar a realizar la tarea comentada. Es decir, un hipervínculo programado con VBA. Sobre las características os remito a este enlace: Método Hyperlinks.Add

En concreto con el parámetro: ScreenTip, definido como: La información en pantalla para que aparezca cuando se sitúa el puntero del ratón sobre el hipervínculo.

Pero claro este método hay que programarlo para que sea funcional y efectivo. Veamos un ejemplo.

Tenemos las siguientes formas:

MOSTRAR UN POPUP EN IMAGEN AL MOVER EL CURSOR POR ENCIMA

Para hacer el ejercicio más claro, vamos a darle nombre a cada forma: “Elipse”, “Triángulo”, “Rectángulo”. El nombre se lo podéis cambiar en el cuadro de nombres, al lado de la barra de fórmulas, solo tenéis que seleccionar la imagen y cambiar el nombre y pulsar enter.

Una vez cambiados y para hacer el ejercicio visual, vamos a incluir en nuestra hoja una serie de parámetros a incluir en el PopUp en cada forma:

MOSTRAR UN POPUP EN IMAGEN AL MOVER EL CURSOR POR ENCIMA_1

En la columna N están los nombres de las formas, que nos servirán como guías para mostrar el dato de la columna O en cada una de las formas.

Ahora copiamos y pegamos el código que he creado:

Sub Crear_PopUp()
'Declaramos variables
Dim miarray As Variant, forma As Variant
Dim nCampo As Object, sItem As Object
Dim nCol As String, dato As String
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Pasamos los nombres de las formas a un array
miarray = Array("Elipse", "Triángulo", "Rectángulo")
'Por cada forma eliminamos hipervínculo
For Each forma In miarray
ActiveSheet.Shapes(forma).Select
On Error Resume Next
Selection.ShapeRange.Item(1).Hyperlink.Delete
On Error GoTo 0
'Pasamos información a la variable dato
Set nCampo = Range("N:N")
Set sItem = nCampo.Find(forma)
nCol = sItem.Address
dato = Range(nCol).Offset(0, 1)
dato2 = Range(nCol).Offset(0, 2)
'Creamos nuevo hipervínculo y pasamos la información al ScreenTip
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:="", ScreenTip:="" & dato & " " & dato2
Next
End Sub

El resultado es el siguiente:

MOSTRAR UN POPUP EN IMAGEN AL MOVER EL CURSOR POR ENCIMA_2

Como podéis comprobar, se ha creado el hipervínculo (que lleva a la misma hoja en la que estamos) y con el texto indicado para la Elipse.

En la macro he habilitado también la columna P para introducir otro dato y que veáis cómo se agregan campos. El efecto conseguido es el que buscamos, cuando nos acercamos a la forma, se muestra el texto y cuando nos alejamos se oculta.

Esto, obviamente lo podéis programar de distintas formas, por ejemplo con un Select Case podéis tener los parámetros de la hoja en el propio código. También que la macro se ejecute cuando se abre el archivo o se activa una celda, etc. El objetivo de este post es mostrar que es posible hacerlo y de una forma sencilla y eficaz.

Y eso es todo, espero que os resulte de utilidad en vuestros cuadros de mando o presentaciones : )

Descarga el archivo de ejemplo pulsando en: MOSTRAR UN POPUP EN IMAGEN AL MOVER EL CURSOR POR ENCIMA

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

OBTENER DÍAS NO TRABAJADOS EN UN PERIODO DE TIEMPO DETERMINADO

Publicado el por

Hola a todos!.

Si recordáis en el post anterior hablamos de la utilidad de la función DIAS.LAB a la hora de obtener días laborables en un determinado periodo de tiempo. Pues bién y fruto de una petición que me han realizado, he decidido hacer un ejercicio práctico pero para obtener los días no trabajados durante un periodo de tiempo determinado.

Si lo pensáis detenidamente, el cálculo de días laborables, nos va a servir tanto para conocer los días no trabajados como trabajados, en función de si los rangos de fecha que tenemos corresponden a trabajados o no trabajados.

Sin embargo, cuando hablamos de días no trabajados, normalmente se hace referencia a “días no trabajados en un determinado periodo de tiempo“. Por ejemplo si se quiere saber el total de días no trabajado en un trimestre: ej “01/01/2019 al 31/03/2019” y tenemos que el rango de días no trabajados de esa persona ha sido del 01/02/2019 hasta el 04/04/2019 Pues bien, los días serán en realidad para el primer trimestre del 01/02/2019 al 31/03/2019, obviando la parte del mes de abril (y los fines de semana y festivos).

Para lograr esto, o bien previamente se filtran las fechas y se modifica la fecha final o inicial según corresponda o se realiza un proceso programado. En este post vamos a hacer un proceso programado:

Vamos con un ejemplo:

OBTENER DÍAS NO TRABAJADOS EN UN PERIODO DE TIEMPO DETERMINADO

Aquí tenemos el rango de días no trabajados de cada persona y todos los festivos del año. El ejercicio será obtener el total de días no trabajados durante el primer trimestre, teniendo en cuenta las fechas de inicio y final y los casos en los que la fecha final está en blanco, es decir, que sigue activa en el presente.

Para facilitar el ejercicio he decidido crear un formulario donde se podrá indicar el rango sobre el que queremos extraer los días, en este ejemplo el trimestre (para ampliar presionar sobre la imagen):

OBTENER DÍAS NO TRABAJADOS EN UN PERIODO DE TIEMPO DETERMINADO_1

Como podéis observar, en el formulario podemos incluir una fecha inicio y otra final, estas fechas serán sobre las que se calculen los días (el formulario está programado para solo incluir fechas, si se introduce un texto o número que no sea fecha, mostrará un mensaje de advertencia).

Cuando presionamos en “CALCULAR DÍAS EN PERIODO” la rutina va a verificar que el rango de los días de cada persona encaja en la fecha indicada en el formulario, de forma que va capturar la información y pasar el nuevo rango a las columnas E y F respectivamente. Observad que en el caso de la fecha abierta, el proceso la marca en rojo y la cierra a fecha fin de nuestro formulario (como debe ser).

O en el caso Inés Chover, donde la fecha final se modifica de 01/04/2019 a “31/03/2019”, dado que no queremos conocer los días en Abril. En caso de ser al contrario e incluir una fecha de inicio ej: en 2018, haría lo mismo y la modificaría a 01/01/2019 como incio.

La macro que realiza esto (es un poco extensa y bastante comentada) es esta, y se ejecuta con el botón “CALCULAR DÍAS EN PERIODO”:

Private Sub CommandButton1_Click()
'DECLARAMOS VARIABLES
Dim INI_PER As Date
Dim FIN_PER As Date
Dim i As Long, fin As Long, j As Long, nCol As Long
Dim v_fecha_1 As Date, v_fecha_2 As Date, rango As Range
With Sheets("Hoja1")
'Si no introducimos una fecha en el formulario, salimos del proceso
v_fecha_1 = IsDate(UserForm1.TextBox1.Value)
v_fecha_2 = IsDate(UserForm1.TextBox2.Value)
If v_fecha_1 = False Or v_fecha_2 = False Then
MsgBox ("DEBES INTRODUCIR UNA FECHA SIGUIENDO EL SIGUIENTE FORMATO DD/MM/AAAA"), vbExclamation, "ERROR EN DATOS"
Exit Sub
ElseIf UserForm1.TextBox1.Value > UserForm1.TextBox2.Value Or UserForm1.TextBox2.Value < UserForm1.TextBox1.Value Then
MsgBox ("VERIFICA EL VALOR DE LAS FECHAS INTRODUCIDAS"), vbExclamation, "ERROR EN DATOS"
Exit Sub
End If
'Pasamos el valor del formulario a variables de inicio y fin de periodo
INI_PER = UserForm1.TextBox1.Value
FIN_PER = UserForm1.TextBox2.Value
fin = Application.CountA(Sheets("Hoja1").Range("A:A"))
.Range("E2:G" & fin + 1).Clear
For j = 2 To fin
If .Cells(j, 4).Interior.Color = vbRed Then
.Cells(j, 4) = vbNullString
.Cells(j, 4).Interior.Pattern = xlNone
End If
Next j
'Marcamos celdas vacías en rojo, si fecha inicio están en el rango
'cerramos la fecha con FIN (USERFORM) sino, dejamos registro vacío
For i = 2 To fin
If .Cells(i, 4) = Empty And .Cells(i, 3) <= FIN_PER Or .Cells(i, 4) = Empty And .Cells(i, 3) >= INI_PER And .Cells(i, 3) <= FIN_PER Then .Cells(i, 4) = FIN_PER .Cells(i, 4).Interior.Color = vbRed ElseIf .Cells(i, 4) = Empty And .Cells(i, 3) > FIN_PER Then
.Cells(i, 4) = " "
.Cells(i, 4).Interior.Color = vbRed
End If
'Si fecha inicial es menor o igual a INICIO (USERFORM) y fecha fin mayor o igual que FIN (USERFORM),
'Indicamos valores de INICIO y FIN
If .Cells(i, 3) <= INI_PER And .Cells(i, 4) >= FIN_PER And .Cells(i, 4) <> " " Then
.Cells(i, 5) = INI_PER
.Cells(i, 6) = FIN_PER
'Si fecha inicial es mayor o igual a INICIO (USERFORM) y fecha fin menor o igual que FIN (USERFORM),
'Indicamos valores de fecha inicio y fecha fin
ElseIf .Cells(i, 3) >= INI_PER And .Cells(i, 4) <= FIN_PER And .Cells(i, 4) <> " " Then
.Cells(i, 5) = CDate(.Cells(i, 3))
.Cells(i, 6) = CDate(.Cells(i, 4))
'Si fecha inicio es mayor o igual que INICIO (USERFORM) y menor o igual que FIN (USERFORM) y fecha fin es mayor o igual que FIN (USERFORM)
'Dejamos fecha inicio y cerramos con FIN (USERFORM)
ElseIf .Cells(i, 3) >= INI_PER And .Cells(i, 3) <= FIN_PER And .Cells(i, 4) >= FIN_PER And .Cells(i, 4) <> " " Then
.Cells(i, 5) = CDate(.Cells(i, 3))
.Cells(i, 6) = FIN_PER
'Si fecha inicio es menor o igual que INICIO (USERFORM) y menor o igual que FIN (USERFORM)y fecha fin es menor o igual que FIN (USERFORM)
'y fecha fin es mayor o igual que INICIO (USERFORM)
'Abrimos con INICIO (USERFORM) y cerramos con fecha_fin
ElseIf .Cells(i, 3) <= INI_PER And .Cells(i, 3) <= FIN_PER And .Cells(i, 4) <= FIN_PER And .Cells(i, 4) >= INI_PER And .Cells(i, 4) <> " " Then
.Cells(i, 5) = INI_PER
.Cells(i, 6) = CDate(.Cells(i, 4))
End If
'Calculamos días hábiles descontando vacaciones o festivos en el periodo
nCol = .Cells(i, Cells.Columns.Count).End(xlToLeft).Column
'Seleccionamos el rango de los días de vacaciones
ActiveSheet.Range(.Cells(i, 8), .Cells(i, (8 + (nCol - 8)))).Select
Set rango = Selection
If .Cells(i, 5) <> Empty Then .Cells(i, 7) = Application.WorksheetFunction.NetworkDays(CDate(.Cells(i, 5)), CDate(.Cells(i, 6)), rango)
Next i
End With
End Sub

Con el botón “RESTABLECER”, preparamos la hoja para una nueva extracción de la información, borrando los rangos y los días calculados y dejando en blanco la fecha abierta.

Private Sub CommandButton2_Click()
Dim fin As Long, i As Long
With Sheets("Hoja1")
With UserForm1
.TextBox1 = Empty
.TextBox2 = Empty
End With
fin = Application.CountA(Sheets("Hoja1").Range("A:A"))
.Range("E2:G" & fin + 1).Clear
For i = 2 To fin
If .Cells(i, 4).Interior.Color = vbRed Then
.Cells(i, 4) = vbNullString
.Cells(i, 4).Interior.Pattern = xlNone
End If
Next i
End With
End Sub

Como habéis podido observar, este procedimiento nos va servir para adaptarlo a todo tipo de cálculo con fechas y periodos de tiempo. El tema de los condicionales, es un poco lioso, pero necesario para identificar todas las casuísticas que se pueden dar entre las fechas y rangos, creo que he identificado todas las posibilidades (racionales) que se pueden dar, obviamente una fecha fin menor que una fecha inicio será un error en vuestra base de datos y el resultado saldrá negativo (así podréis verificar si la calidad de los datos es correcta, por lo menos en lo que a fechas se refiere).

Dado que tener en cuenta los días festivos o que no se deben tener en cuenta es importante, la macro también tiene los tiene en cuenta y los descuenta de los días totales.

Y eso es todo, creo que es un post muy interesante y útil dado que ahorra mucho de tiempo de trabajo y de repaso de la información.

Descarga el archivo de ejemplo pulsando en: OBTENER DÍAS NO TRABAJADOS EN UN PERIODO DE TIEMPO DETERMINADO

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

PROGRAMAR LA FUNCIÓN DIAS.LAB CON VBA Y AUTOMATIZAR DÍAS DE VACACIONES

Publicado el por

Hola a todos!

Hace unos días respondía a la consulta que me enviaba un lector sobre la posibilidad de programar la función DIAS.LAB (os dejo el enlace a la microsoft donde se explica esta fórmula).

Tal y como se expone en la web, su función es la siguiente: “Devuelve el número de días laborables entre fecha_inicial y fecha_final. Los días laborables no incluyen los fines de semana ni otras fechas que se identifiquen en el argumento vacaciones.”

Su sintaxis es: Fecha Inicial, Fecha Final , Vacaciones (o días festivos).

Pues bien, se puede automatizar y además incluyendo el rango de días festivos o de vacaciones que hayamos indicado.

Veamos un ejemplo con unas cuantas personas (clic en la imagen para ampliar):

PROGRAMAR LA FUNCIÓN DIAS.LAB CON VBA Y AUTOMATIZAR DÍAS DE VACACIONES

Como podéis observar estoy teniendo en cuenta una fecha inicial y final para todos igual, es decir, todo el año 2019. Y los días de vacaciones distintos para cada uno de ellos.

El objetivo es calcular los días laborables del año descontando los días festivos/vacaciones (columnas “F” y posteriores) y completar la columna “E”.

Esto lo vamos a hacer con la siguiente macro:

Sub DIAS_LAB()
'Declaramos variables
Dim i As Long, Final As Long
Dim Rango As Range, nCol As Long
With Sheets("Hoja1")
Final = Application.CountA(.Range("A:A"))
'Con un loop recorremos cada registro
For i = 2 To Final
'Detectamos la última celda con datos de cada fila
nCol = .Cells(i, Cells.Columns.Count).End(xlToLeft).Column
'Seleccionamos el rango de los días de vacaciones
ActiveSheet.Range(.Cells(i, 6), .Cells(i, (6 + (nCol - 6)))).Select
Set Rango = Selection
'Calculamos los días
.Cells(i, 5) = Application.WorksheetFunction.NetworkDays(CDate(.Cells(i, 3)), CDate(.Cells(i, 4)), Rango)
Next i
End With
End Sub

Para poder capturar automáticamente los días de vacaciones, ha optado por utilizar un rango variable que funciona gracias a la detección de la última celda de cada fila que contiene datos. El resto simplemente es completar los argumentos de la función “NetworkDays”.

El resultado es el siguiente (clic en la imagen para ampliar):

PROGRAMAR LA FUNCIÓN DIAS.LAB CON VBA Y AUTOMATIZAR DÍAS DE VACACIONES_1

Como podéis observar, ya hemos calculado el total de días por persona.

Este es solo un ejemplo de programación, se podría utilizar la propia función DIAS.LAB para calcular los días de vacaciones en un rango inicial y final (de mismo que para los días laborales, pero de vacaciones), evitando así el tener que indicar día por días las vacaciones.

Y eso es todo, espero que os sea de utilidad : )

Descarga el archivo de ejemplo pulsando en: PROGRAMAR LA FUNCIÓN DIAS.LAB CON VBA Y AUTOMATIZAR DÍAS DE VACACIONES

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

FUNCIÓN PARA CONTAR LAS VECES QUE SE REPITE UN CARACTER O TEXTO EN UNA CELDA

Publicado el por

Hola a todos:

En el post de hoy os voy a mostrar una sencilla UDF con la que vamos a poder contar las veces que se repite un carácter específico o una cadena de texto en una celda.

La función no distinguirá entre mayúsculas o minúsculas y se podrá aplicar también a caracteres numéricos.

Vamos con un ejemplo sobre un texto, para ello utilizaremos un poema en prosa poética:

FUNCION PARA CONTAR LAS VECES QUE SE REPITE UN CARACTER O TEXTO EN UNA CELDA

Pues bien, por ejemplo, vamos a contar las veces que se repite la “m” en nuestro texto, independientemente si es mayúscula o minúscula.

Lo haremos con esta función que vamos a llamar CONTARV:

Function CONTARV(ByVal target As Range, Valor As String)
'Declaramos variables
Dim Cuenta As Long
Dim Dato As String, celda As Variant
'Por cada celda seleccionada
'Componemos un string (en el que contaremos)
For Each celda In target
Dato = Dato & " " & celda
Next celda
'Contamos cadena de texto o caracter
Cuenta = UBound(Split(LCase(Dato), LCase(Valor)))
'Pasamos el resultado a la función
CONTARV = Cuenta
End Function

Este es el resultado:

FUNCION PARA CONTAR LAS VECES QUE SE REPITE UN CARACTER O TEXTO EN UNA CELDA_1

Y así es como obtenemos el resultado. En este caso, la suma es de 27 veces la letra “m”.

Si lo que deseáis es que la función tenga en cuenta mayúsculas y minúsculas, solo tenéis que eliminar la función LCase aplicada a las variables “Dato” y “Valor”.

Si queremos contar todo el rango en una única celda, también lo podemos hacer:

FUNCION PARA CONTAR LAS VECES QUE SE REPITE UN CARACTER O TEXTO EN UNA CELDA_2

Esta es una versión más eficiente de otra macro que realiza la misma tarea: CONTAR CARACTERES ESPECÍFICOS EN UN RANGO SELECCIONADO

Y eso es todo, espero que os haya resultado de interés y la podáis utilizar en vuestros trabajos y proyectos.

Descarga el archivo de ejemplo pulsando en: FUNCIÓN PARA CONTAR LAS VECES QUE SE REPITE UN CARACTER O TEXTO EN UNA CELDA

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies