CONTAR TODOS LOS CARACTERES DE UN RANGO SELECCIONADO. FUNCIÓN LARGOX

Hola a todos!.

Hace unos meses programé una función para sumar el contenido una celda o rango aunque contasen con datos alfanuméricos: SUMAR EL CONTENIDO DE UNA CELDA O DE UN RANGO CON O SIN CARACTERES ALFANUMÉRICOS

Lo realmente importante de la función es la de poder programar la función Split cuando no existe un delimitador.

Pues bien, hoy he modificado la función para contar el contenido de una celda o rango. Algo parecido a la función Largo(), pero que permite contar también en un rango.

La función que vamos a utilizar la he denominado LargoX():

Option Explicit
Function LARGOX(ByVal Target As Range)
Dim celda As Variant, sCadena As String
Dim dato As Variant, numero As Long, contador As Long
'Por cada celda en el rango
For Each celda In Target
'si la celda tiene contenido
If celda <> Empty Then
'obtenemos la cadena y la convertimos a unicode, añadiendo Chr(0) entre cada letra
sCadena = Left(StrConv(celda, vbUnicode), Len(StrConv(celda, vbUnicode)) - 1)
'con la función Split delimitamos la cadena.
For Each dato In Split(sCadena, Chr(0))
'Sumamos cada número
contador = contador + 1
Next dato
End If
Next celda
' Pasamos el resultado a la función
LARGOX = contador
End Function

y así podemos utilizar la función de esta forma:

CONTAR TODOS LOS CARACTERES DE UN RANGO SELECCIONADO. FUNCION LARGOX

Y con esto ya tenemos una nueva función que nos va a servir para contar los caracteres contenidos en una celda o en un rango. Este código también se puede modificar para contar un carácter específico, pero en esta web ya existen varios ejemplos que lo hacen.

Y esto es todo, espero que os os resulte de utilidad!.

Descarga el archivo de ejemplo pulsando en: CONTAR TODOS LOS CARACTERES DE UN RANGO SELECCIONADO. FUNCIÓN LARGOX

¿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

PRINCIPALES BUCLES EN VBA

Hola a todos, espero que  estéis disfrutando de este espléndido fin de semana!.

Antes de salir a dar el paso de la tarde, he decidido escribir un post sobre los principales bucles o loops que podemos programar en VBA.

Sobre este tema ya desarrollé en su momento (2016) un post en el que explicaba cuatro tipos de bucles: For – next, Do – While, Do – Until y Do While Booleana (esta última una variante de la anterior.

Como no me gusta volver a repetir y escribir lo mismo, os dejo la referencia al post: ¿CÓMO REALIZAR UN BUCLE EN VBA?

En aquel momento decidí no incluir un 5 tipo, pero creo que es necesario para que el post quede completo y mejorado 🙂

Se trata de la instrucción For-Each (aquí tenéis su definición: Instrucción For-Each), en el ejemplo que nos ocupa:

PRINCIPALES BUCLES EN VBA

Al igual que el resto de bucles, en este ejemplo si los números de la columna 1 son mayores de 5 entonces en la columna F pondremos “Mayor que 5” y si es menor o igual a 5 entonces pondremos “Menor o igual a 5” .

La programación de la instrucción sería así:

Sub FOR_EACH()
Dim i As Double
Dim celda As Object
With Sheets(1)
Fin = Application.CountA(.Range("A:A"))
For Each celda In .Range("A2:A" & Fin)
If celda > 5 Then celda.Offset(0, 5) = "Mayor que 5"
If celda <= 5 Then celda.Offset(0, 5) = "Menor o igual a 5"
Next celda
End With
End Sub

Como podéis observar su programación es sencilla, y en en este caso he utilizado Offset para hacer referencia a la columna 6 de la nuestra tabla y así poder mostrar el valor que queremos indicar.

Este es el resultado de todos los bucles aplicados:

PRINCIPALES BUCLES EN VBA_1

Descarga el archivo de ejemplo pulsando en: PRINCIPALES BUCLES EN VBA

¿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

MÉTODO SORT EN ARRAYLIST PARA ALFANUMÉRICOS Y ALGORITMO DE BURBUJA PARA NUMÉRICOS

Hola a todos:

Este post está centrado en la ordenación de arrays, no entraré en el método range.sort dado que no se trata de rangos sino de array (independientemente que para este ejemplo obtenga la información de un rango).

Cuando programamos rutinas largas o algoritmos complejos, es muy normal tener que ordenar información almacenada en matrices o “arreglos”. No es jugar con un rango de la hoja, es trabajar con grandes cadenas de información.

Para realizar la ordenación, podemos usar algunas técnicas o métodos. Aunque ya están algunos de ellos publicado en esta web, conviene recordarlos y exponerlos con un ejemplo visual par comprender su funcionamiento.

Por ejemplo, para realizar ordenaciones con datos alfanuméricos, siempre recomiendo utilizar el método Sort y aplicarlos en ArrayList, dato que podemos convertir creando el objeto:

Set MiMatriz = CreateObject("System.Collections.ArrayList")

Cuando digo alfanumérico, me refiero a todo letras o letras y números. Nunca a únicamente números. Si tenemos que aplicar este método a números, funcionará siempre que apliquemos a números menores de 10, de otra forma produce ordenamientos no convencionales.

Con esta rutina podéis ver cómo seleccionado los datos de un rango de una hoja los pasamos a un ListBox (ordenados).

METODO SORT EN ARRAYLIST PARA ALFANUMÉRICOS Y AB PARA NUMERICOS

El código es este:

Sub ORDENAR_LIST()
'Definimos variables
Dim MiMatriz As Object, celda As Variant, nItem As Variant
'Vaciamos listbox
Call BORRAR
With Sheets("ORDENAR")
'Creamos objeto ArrayList
Set MiMatriz = CreateObject("System.Collections.ArrayList")
'Pasamos los datos seleccionados al ArrayList
'Si la celda está vacía, no la tenemos en cuenta
For Each celda In Selection
If Not IsEmpty(celda) And Not IsNumeric(celda) Then MiMatriz.Add CStr((celda))
Next celda
'Ordenamos
MiMatriz.Sort
MiMatriz.Reverse
'Pasamos la información al listbox
For Each nItem In MiMatriz
.ListBox1.AddItem (nItem)
Next nItem
End With
End Sub

Si queréis revertir el orden de ordenamiento solo tenéis que “descomentar” en el código 'MiMatriz.Reverse

Si lo que vamos a hacer es con números, entonces lo mejor es utilizar el algoritmo de ordenamientos de burbuja (o alguna de sus derivadas):

METODO SORT EN ARRAYLIST PARA ALFANUMÉRICOS Y AB PARA NUMERICOS_1

Y esta es la rutina:

Sub ORDENAR_STRING_NUMERO()
'Declaramos variables
Dim Rng As Range, fin As Long, celda As Variant
Dim Scadena As String, Valor As Variant, i, MiCadena As String
Dim miArray As Variant, Control As Boolean, BetaString As Double
Dim Valores As Variant, n, Max As String, Min As String
Dim Mensaje As Variant, Listado As Variant
Call BORRAR
'Seleccionamos rango con datos
Set Rng = Selection
'Componemos cadena si la celda tiene datos y es un número
For Each celda In Rng
If celda <> vbNullString And IsNumeric(celda) Then
MiCadena = MiCadena & " " & celda.Value
End If
Next celda
Scadena = Trim(MiCadena)
'Si la selección está vacía, salimos del procedimiento
If Scadena = vbNullString Then Exit Sub
'Pasamos la cadena a un array
Valor = Split(Scadena, " ")
ReDim miArray(0 To UBound(Valor))
For i = 0 To UBound(Valor)
miArray(i) = CDbl(Valor(i))
Next i
'Iniciamos loop y bucles para realizar
'algoritmo de burbuja
Do
Control = True
For i = 0 To UBound(miArray) - 1
If miArray(i) > miArray(i + 1) Then
Control = False
BetaString = miArray(i)
miArray(i) = miArray(i + 1)
miArray(i + 1) = BetaString
End If
Next i
Loop While Not (Control)
For Each nItem In miArray
Sheets("ORDENAR").ListBox1.AddItem (nItem)
Next nItem
End Sub

Si queréis revertir el orden de ordenamiento solo tenéis que cambiar el signo en esta línea del código: If miArray(i) > miArray(i + 1) Then

Y con estas dos técnicas podréis realizar ordenamientos seguros en vuestros arrays o matrices.

El uso del listbox en este post es anecdótico, lo utilizo exclusivamente para mostrar la ordenación de los datos.

Descarga el archivo de ejemplo pulsando en: MÉTODO SORT EN ARRAYLIST PARA ALFANUMÉRICOS Y ALGORITMO DE BURBUJA PARA NUMÉRICOS

¿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 EL CONTENIDO DE UNA CELDA O DE UN RANGO CON O SIN CARACTERES ALFANUMÉRICOS

Hola a todos!

Hoy vamos a trabajar con una UDF que he programado para obtener la suma de todos los caracteres (obviamente numéricos) de una celda o varias celdas en un rango.

El post tiene dos objetivos, por una parte mostrar la UDF y por otra programar la función Split para utilizarla cuando no existe un delimitador. Si no estáis familiarizados con la función Split, os dejo este enlace.

Pues bien, imaginad que tenemos varias celdas con datos numéricos y alfanuméricos y queremos obtener la suma de los números:

SUMAR EL CONTENIDO DE UNA CELDA O DE UN RANGO

Pues para poder hacer esto, os propongo la siguiente función:

Option Explicit
Function SUMARV(ByVal Target As Range)
Dim celda As Variant, sCadena As String
Dim dato As Variant, numero As Long
'Por cada celda en el rango
For Each celda In Target
'si la celda tiene contenido
If celda <> Empty Then
'obtenemos la cadena y la convertimos a unicode, añadiendo Chr(0) entre cada letra
sCadena = Left(StrConv(celda, vbUnicode), Len(StrConv(celda, vbUnicode)) - 1)
'con la función Split delimitamos la cadena.
For Each dato In Split(sCadena, Chr(0))
'Sumamos cada número
If IsNumeric(dato) Then numero = numero + CInt(dato)
Next dato
End If
Next celda
' Pasamos el resultado a la función
SUMARV = numero
End Function

Como podéis ver, utilizamos la función StrConv(celda, vbUnicode) para pasar lo datos a Unicode, esto generará delante y detrás de cada carácter un Chr(0). Esto nos va a permitir utilizar la función Split y separar cada letra o número y evaluar si lo podemos sumar.

Lo podríamos hacer perfectamente con un for y la función Mid(), pero así resulta mucho más rápido y eficiente.

Este es el resultado de la suma: 1357

SUMAR EL CONTENIDO DE UNA CELDA O DE UN RANGO_1

Y eso es todo, es una función muy interesante y con la que he disfrutando creándola.

Descarga el archivo de ejemplo pulsando en: SUMAR EL CONTENIDO DE UNA CELDA O DE UN RANGO CON O SIN CARACTERES ALFANUMÉRICOS

¿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 LAS PROPIEDADES DE TODOS LOS ARCHIVOS DE UNA CARPETA Y SUBCARPETAS CON EL OBJETO SHELL

Hola a todos!.

En esta web tengo varios post dedicados a listar los archivos de una carpeta y sus subcarpetas en concreto estos:

LISTAR TODOS LOS ARCHIVOS DE UNA CARPETA Y SUS SUBCARPETAS CON VBA

LISTAR LAS PROPIEDADES DE TODOS LOS ARCHIVOS DE UNA CARPETA Y SUBCARPETAS

y estos otros para listar los archivos que hayamos seleccionado y mostrar sus propiedades:

LISTAR TODOS LOS ARCHIVOS SELECCIONADOS

MOSTRAR PROPIEDADES DE ARCHIVOS SELECCIONADOS

Pues bien, hace unos días me enviaron la siguiente consulta:

“Hola Segu, gran trabajo y no sólo inicial, sino además contestando y mejorandolo con todas las preguntas.
Yo te quisiera hacer otra: Dentro de las propiedades de ficheros TIFF, jpg y pdf también tenemos las propiedades de Resolución Horizontal y Resolución Vertical (son propiedades como las de fecha de última modificación o tamaño) ¿Como se podrían extraer?.
Muchas gracias de antemano.”

La respuesta es que sí es posible, pero no podremos realizarlo con el objeto FileSystemObject (FSO) que utilizamos en los códigos anteriores, aunque sí vamos a aprovecharlo en parte de la macro donde utilizamos los métodos GetFolder y GetSubfolder que son necesarios para recorrer las carpetas y subcarpetas que hayamos seleccionado.

Para poder obtener la resolución horizontal y vertical (y muchas otras propiedades), debemos utilizar el objeto Shell necesario para interactuar con la librería Shell32.dll. Con este objeto vamos a poder extraer multitud de propiedades. Para que os hagáis una idea, hasta 349 propiedades aproximadamente pueden ser extraídas (según tipo de archivo), y entre ellas, la resolución.

En el código que os mostraré vamos a utilizar referencias tempranas (dado que es un poco más rápido que hacerlo con referencias tardías). Para ello es necesario que estén seleccionadas las siguiente referencias (en este archivo ya os las he seleccionado):

  • Microsoft Shell Controls And Automation
  • Microsoft Scripting Runtime

LISTAR LAS PROPIEDADES DE TODOS LOS ARCHIVOS DE UNA CARPETA Y SUBCARPETAS CON EL OBJETO SHELL

En caso de que no queráis depender de la biblioteca de referencias, solo tenéis que sustituir en el código:

Set sFSO = New FileSystemObject por esto Set sFSO = CreateObject("Scripting.FileSystemObject")

y Set objShell = New Shell por esto Set objShell = CreateObject("shell.application")

Veamos el ejemplo que nos ocupa. Imaginad estas imágenes y que necesitamos obtener y listar el dato de su resolución:

LISTAR LAS PROPIEDADES DE TODOS LOS ARCHIVOS DE UNA CARPETA Y SUBCARPETAS CON EL OBJETO SHELL_1

Para hacerlo vamos a utilizar la siguiente macro, donde el procedimiento Sub() ya lo conocéis de las funciones de los post anteriores, (aunque aquí estoy declarando FSO con referencia temprana). En cuanto a la función, es ahí donde programamos el objeto Shell y en este ejemplo únicamente voy a extraer el nombre, tamaño y las resoluciones (vertical y horizontal):

Option Explicit
Sub LISTAR_ARCHIVOS()
'Declaramos variables
Dim sFSO As Object, directorio As String
Dim dir_archivo As Variant
Call limpiar
'Abrimos ventana de diálogo para seleccionar carpeta
Set dir_archivo = Application.FileDialog(msoFileDialogFolderPicker)
dir_archivo.Show
'Si no seleccionamos nada salimos del proceso
If dir_archivo.SelectedItems.Count = 0 Then
Exit Sub
End If
'Capturamos el directorio del archivo seleccionado
directorio = dir_archivo.SelectedItems(1)
'Creamos objeto y ejecutamos función Carpeta
Set sFSO = New FileSystemObject
CARPETA sFSO.GetFolder(directorio)
End Sub

Function CARPETA(ByVal nCarpeta)
'Declaramos variables
Dim j As Long, d As Long, n As Variant
Dim Subcarpeta As Object, objCarpeta As Object, objShell As Object
Dim item As Object
With Sheets("Hoja2")
'Iniciamos loop, que recorre las carpetas
For Each Subcarpeta In nCarpeta.SubFolders
CARPETA Subcarpeta
Next
'Creamos objeto Shell
n = nCarpeta
Set objShell = New Shell
'creamos carpeta con la función namespace. N debe ser variant
Set objCarpeta = objShell.Namespace(n)
'Creamos variable como contador
j = Application.CountA(.Range("A:A")) + 1
'Por cada ítem o archivo en la carpeta, obtenemos: Nombre (0), tamaño (1)
'Resolución horizontal (175), Resolución Vertical (177)
For Each item In objCarpeta.Items
.Cells(j, 1).Select
.Hyperlinks.Add Anchor:=Selection, Address:=item.Path, TextToDisplay:=item.name
'NOMBRE
.Cells(j, 1) = objCarpeta.GetDetailsOf(item, 0)
'TAMAÑO
.Cells(j, 2) = objCarpeta.GetDetailsOf(item, 1)
'RESOLUCION HORIZONTAL
.Cells(j, 3) = objCarpeta.GetDetailsOf(item, 175)
'RESOLUCION VERTICAL
.Cells(j, 4) = objCarpeta.GetDetailsOf(item, 177)
j = j + 1
Next item
End With
End Function

El resultado es este:

LISTAR LAS PROPIEDADES DE TODOS LOS ARCHIVOS DE UNA CARPETA Y SUBCARPETAS CON EL OBJETO SHELL_2

Como podéis observar, obtenemos los datos que necesitamos, en este caso la resolución es la misma en todos los casos.

Y con esto ya estaría resuelta la consulta que me han realizado. Pero como me ha parecido interesante el poder programar este objeto, he implementado otro código que genera hasta las 350 propiedades, las nombra y extrae el dato de cada una de ellas por cada archivo en la carpeta.

El procedimiento Sub no lo voy a pegar otra vez, dado que es el mismo. Pero la función cambia de manera sustancial. Ojo con esta macro, si seleccionáis una carpeta con muchos archivos y teniendo en cuenta que por cada uno extrae 350 elementos es probable que al equipo le cueste un poco. Ese es el motivo de haber dejado el primer ejemplo con los cuatro elementos para que podéis extraer solo lo que necesitéis mucho más rápido.

Function CARPETA(ByVal nCarpeta)
'Declaramos variables
Dim j As Long, d As Long, n As Variant
Dim Subcarpeta As Object, objShell As Object, objCarpeta As Object
Dim item As Object, name As Variant, i As Long
With Sheets("Hoja1")
'Iniciamos loop, que recorre las carpetas
For Each Subcarpeta In nCarpeta.SubFolders
CARPETA Subcarpeta
Next
'Creamos objeto Shell
n = nCarpeta
Set objShell = New Shell
'creamos carpeta con la funcion namespace
Set objCarpeta = objShell.Namespace(n)
'Obtenemos encabezados automáticamente con el método GetdetailsOf
'Que mostrará el nombre de cada valor
For i = 0 To 350
.Cells(1, i + 1) = i & "-" & objCarpeta.GetDetailsOf(name, i)
Next i
'Creamos variable como contador
j = Application.CountA(.Range("A:A")) + 1
'Por cada ítem o archivo en la carpeta, obtenemos cada uno de los elementos
'en este caso 350 donde el 1, es el nombre, el dos el tamaño, etc (en la vble "d")
For Each item In objCarpeta.Items
For d = 0 To 350
.Cells(j, 1).Select
.Hyperlinks.Add Anchor:=Selection, Address:=item.Path, TextToDisplay:=item.name
.Cells(j, d + 1) = objCarpeta.GetDetailsOf(item, d)
Next d
j = j + 1
Next item
End With
End Function

Y este es el mismo resultado con las imágenes anteriores:

LISTAR LAS PROPIEDADES DE TODOS LOS ARCHIVOS DE UNA CARPETA Y SUBCARPETAS CON EL OBJETO SHELL_3

No puedo mostrar todas las propiedades hasta las 350, pero como véis podemos extraer mucha información.

Y esto es todo!, espero que os sea de utilidad!!.

Normalmente os dejo el archivo en wordpress, pero esta vez tengo que alojarlo en Drive, el motivo es el de siempre, si el archivo es xlsm no puedo subirlo a mi web (políticas de WordPress.com).

Descarga el archivo de ejemplo pulsando en: LISTAR LAS PROPIEDADES DE TODOS LOS ARCHIVOS DE UNA CARPETA Y SUBCARPETAS CON EL OBJETO SHELL

¿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

MACRO PARA PASAR A VALORES UNA FÓRMULA ESPECÍFICA

Hola a todos:

Recientemente he recibido la siguiente consulta:

“Buenos días, Le escribo por si pudiese ayúdame con lo siguiente. Tengo la siguiente macro, que lo que hace es una fórmula que hace (una UDF) ……… 

…………. ¿Es posible hacer con vba otra macro que lo que haga es dejar exclusivamente las celdas que tengan esta fórmula como valores?

Mil gracias,”

Es decir, el lector tiene una UDF o función definida por él mismo y desea una macro que sea capaz de identificar esta función y pasar su resultado a valores. Obviamente debería ser capaz de pasar a valores cualquier tipo de fórmula que le indiquemos, dado que una UDF no deja de ser una fórmula más. Los puntos suspensivos los he puesto yo para no reproducir todo el correo.

Para ilustrar este ejemplo voy a usar una hoja Excel con varias fórmulas, todas ellas son fórmulas de Excel, ninguna es una UDF, pero el resultado es el mismo:

MACRO PARA PASAR A VALORES UNA FÓRMULA ESPECÍFICA_1

Como podéis ver, en rojo está el nombre de las funciones empleadas pero en Inglés. Esto será necesario para la macro. Os dejo de todas formas las funciones empleadas en cada ejemplo.

MACRO PARA PASAR A VALORES UNA FÓRMULA ESPECÍFICA

Pues bien, vamos a pasar a valores las siguientes funciones:

  • “IFERROR(IF(MATCH” o lo que es lo mismo =SI.ERROR(SI(COINCIDIR
  • “IF(SUMPRODUCT” o lo que es lo mismo =SI(SUMAPRODUCTO

Y este es el código que vamos a utilizar:

Option Explicit
Sub PASAR_VALOR()
'Declaramos variables
Dim MiRango As Object, celda As Variant, D As Long
ActiveSheet.Select
'Si no hay fórmulas en la hoja, controlamos el error
'y mostramos mensaje en etiqueta
On Error GoTo etiqueta
Set MiRango = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
'Si existe fórmula pasamos al procedimiento
D = 1
For Each celda In MiRango
If InStr(celda.Formula, "IFERROR(IF(MATCH") Or _
InStr(celda.Formula, "IF(SUMPRODUCT") Then
celda.Formula = celda.Value
D = D + 1
End If
Next
'Si las funciones elegidas están la página, mostramos mensaje
If D > 1 Then MsgBox ("LAS FORMULAS HAN SIDO CAMBIADAS A VALORES"), vbInformation
Set MiRango = Nothing: Close
Exit Sub
etiqueta: MsgBox ("NO EXISTEN FÓRMULAS EN LA HOJA ACTIVA"), vbExclamation
End Sub

Como podéis observar, cuando la fórmula es nativa de Excel, debemos indicarla en inglés, si se trata de una UDF que hemos creado nosotros, debemos indicarla con el nombre con la que la hemos creado.

Una vez ejecutado el código, las celdas con esas funciones solo contendrán el valor.

Descarga el archivo de ejemplo pulsando en: MACRO PARA PASAR A VALORES UNA FÓRMULA ESPECÍFICA

¿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

ELIMINAR FILAS VACÍAS SI TODAS LAS CELDAS DEL RANGO ESTÁN EN BLANCO PARTE II

Hola a todos!:

Este post es continuación del anterior: ELIMINAR FILAS VACÍAS SI TODAS LAS CELDAS DEL RANGO ESTÁN EN BLANCO , en el que utilizábamos un ciclo “Do Until”  para eliminar filas en blanco cuando toda la fila (o el rango indicado) estuviese vacía.

Un lector me indicó que sería más sencillo de utilizar un For – Next, dado que era una estructura de programación más fácil de comprender en su funcionamiento. Bien, esto usualmente es así y los procedimientos for – next resultan más sencillos de comprender que los loop tipo: Do While o Do Until.

En este caso, creo que aporta información útil para todos nosotros y he decidido publicarlo. He variado la base de datos para que no sea siempre la misma y he utilizado una hoja de varios miles de registros para el ejemplo:

ELIMINAR FILAS VACÍAS SI TODAS LAS CELDAS DEL RANGO ESTÁN EN BLANCO PARTE II

Vamos a usar la siguiente rutina para realizar el ejercicio de eliminar filas en blanco, solo tendréis que añadir varias filas en blanco y ejecutar el código.

Option Explicit
Sub ELIMINAR_FILAS_VACIAS()
'Declaramos variables
Dim mirango As Object
Dim i As Long
With ActiveSheet
'Contamos hasta la última celda con datos
For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
'Si la fila está vacía comenzamos el proceso
If .Application.CountA(Range(i & ":" & i)) = 0 Then
'Si el rango está vacío guardamos primera fila vacía
If mirango Is Nothing Then
Set mirango = Rows(i)
Else
'Si no está vacío utilizamos función Unión()
Set mirango = Union(mirango, Rows(i))
End If
End If
Next i
'Eliminamos contenido de mirango
If Not mirango Is Nothing Then mirango.Delete
End With
'cerramos variable
Set mirango = Nothing: Close
End Sub

El resultado será que la macro va a eliminar la fila o filas vacías en el rango indicado.

Y eso es todo, espero que os haya resultado interesante!.

Descarga el archivo de ejemplo pulsando en: ELIMINAR FILAS VACÍAS SI TODAS LAS CELDAS DEL RANGO ESTÁN EN BLANCO_II

¿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