UDF BUSCARZ. BÚSQUEDA A LA IZQUIERDA Y MOSTRAR TODAS LAS COINCIDENCIAS. PARTE I

Publicado el por

Hola a todos!!

¿Qué tal estáis?, espero que bien y que hayáis descansado en vuestras vacaciones. Hoy retomo las publicaciones de la web y estoy seguro que la de hoy os va a resultar muy interesante.

Hace unas semanas se publicó en todos las redes la aparición de una nueva función de búsqueda: “BUSCARX“. Esta función viene a dar solución a muchas de las carencias que tenía la fórmula BUSCARV y también ampliar funcionalidades. Esta nueva fórmula no estará disponible para todos hasta el año que viene y eso es lo que me ha hecho reflexionar sobre las carencias actuales de BUSCARV y todo lo que podemos hacer nosotros, como usuarios de VBA para encontrar soluciones.

Por lo tanto, he creado una nueva función que he denominado BUSCARZ y en la que podremos hacer lo siguiente:

  • Buscar valores a la izquierda de la matriz.
  • Mostrar el primer valor encontrado desde “arriba hacia abajo” (descendente).
  • Mostrar el primer valor encontrado desde “abajo hacia arriba” (ascendente).
  • Mostrar todas las coincidencias en una búsqueda.

Os presento el código de la función:

Option Explicit
Function BUSCARZ(ByVal DATO_BUSCADO As Variant, RANGO_BUSQUEDA As Range, COLUMNA As String, TIPO_BUSQUEDA As Integer)
'Declaramos variables
Dim nCOLUMN As String, nCELDA As String, CELDA As Variant
Dim VALOR_INICIAL As String, VALOR_FINAL As String
Dim VALOR_TOTAL As String, TODOS As String, HOJA As String
'capturamos hoja en la que se buscan datos
HOJA = RANGO_BUSQUEDA.Parent.Name
'Indicamos letra de la columna
nCOLUMN = COLUMNA
'nCOLUMN = Replace(Split(COLUMNA.Address, "$")(1), ":", "")
'Por cada celda en el rango seleccionado de búsqueda
For Each CELDA In RANGO_BUSQUEDA
'Si la celda no igual al dato seleccionado entonces indicamos #N/A
If UCase(CELDA) <> UCase(DATO_BUSCADO) Then BUSCARZ = "#N/A"
'Si la celda es igual al dato seleccionado entonces
If UCase(CELDA) Like UCase(DATO_BUSCADO) Then
'Obtenemos numero de la celda en el que estamos
nCELDA = Split(CELDA.Address, "$")(2)
'Si el tipo de búsqueda no es 2 o 3, entonces obtenemos el primer valor encontrado
'buscando de forma descendente
If TIPO_BUSQUEDA > 3 Or TIPO_BUSQUEDA <= 1 Then
VALOR_INICIAL = Sheets(HOJA).Range(nCOLUMN & nCELDA)
'Pasamos el valor a la función
BUSCARZ = VALOR_INICIAL
Exit For
End If
'Obtenemos el valor final
VALOR_FINAL = Sheets(HOJA).Range(nCOLUMN & nCELDA)
'obtenemos string con todos los valores encontrados
TODOS = Trim(TODOS & "|" & VALOR_FINAL)
VALOR_TOTAL = Mid(TODOS, 2, Len(TODOS))
End If
'Pasamos los valores a la función
If TIPO_BUSQUEDA = 2 Then
BUSCARZ = VALOR_FINAL
ElseIf TIPO_BUSQUEDA = 3 Then
BUSCARZ = VALOR_TOTAL
End If
Next CELDA
End Function

La sintaxis de la función es la siguiente:

  • DATO_BUSCADO: Es el valor que vamos a buscar. Podemos hacer referencia o indicar el valor entre comillas dobles ” “.
  • RANGO_BUSQUEDA: Es el rango sobre el que buscamos los datos.
  • COLUMNA: Determina la columna sobre la que vamos a extraer la información.
  • TIPO_BUSQUEDA: a elegir sobre tres tipos:
    • 1 – Mostrar el primer valor encontrado desde “arriba hacia abajo” (descendente).
    • 2 – Mostrar el primer valor encontrado desde “abajo hacia arriba” (ascendente).
    • 3 – Mostrar todas las coincidencias en una búsqueda. Entre cada resultado se añade una barra vertical.

Llegados a este punto, creo que lo interesante será hacer un ejemplo. Empezaremos con una búsqueda de tipo 1 y de datos a la izquierda, traemos información de la columna “A”.

UDF BUSCARZ. REALIZAR BUSQUEDAS A LA DERECHA Y ENCONTRAR TODAS LAS COINCIDENCIAS. PARTE I

Búsqueda de tipo 2 y de datos a la izquierda, traemos información de la columna “A”.

UDF BUSCARZ. REALIZAR BUSQUEDAS A LA DERECHA Y ENCONTRAR TODAS LAS COINCIDENCIAS. PARTE I_1

Búsqueda de tipo 3 y de datos a la izquierda, traemos información agrupada de la columna “A”.

UDF BUSCARZ. REALIZAR BUSQUEDAS A LA DERECHA Y ENCONTRAR TODAS LAS COINCIDENCIAS. PARTE I_2

La función también permite buscar en otras páginas y otros libros.

Nota: esta función la he programado en unas pocas horas. Si notáis que algo no funciona correctamente, por favor, pasadme feed.

Aunque son algunas mejoras interesantes, tengo pensado añadir y ampliar nuevas funcionalidades, así que iré actualizando el post en distintas publicaciones.

Ahora os dejo el archivo de prueba como siempre.

Descarga el archivo de ejemplo pulsando en: UDF BUSCARZ. BÚSQUEDA A LA IZQUIERDA Y MOSTRAR TODAS LAS COINCIDENCIAS. PARTE I

¿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

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

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