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

ÍTEMS EN LISTBOX CON COLORES. CONTROL LISTVIEW

Hola a todos:

Cuando cargamos los datos en un listbox puede ser que necesitemos que se coloreen o remarquen ciertos ítems de un color determinado según una condición. Esto no lo vamos a lograr con un listbox, sino con otro control de formulario muy parecido, el listview.

Este control lo podremos instalar pulsando con el botón derecho del ratón en el cuadro de herramientas de nuestro formulario.

ITEMS EN LISTBOX CON COLORES. CONTROL LISTVIEW

y a continuación pulsando en “Controles adicionales” y seleccionando Microsoft ListView Control, versión 6.0 

ITEMS EN LISTBOX CON COLORES. CONTROL LISTVIEW_1

Una vez instalado ya lo podemos programar y usar. En la imagen anterior véis que se trata de un control muy parecido al listbox.

Pues bien, vamos a hacer un ejercicio de ejemplo para que veais como podemos programar este control de formulario.

ITEMS EN LISTBOX CON COLORES. CONTROL LISTVIEW_2

Dada esta base de datos, vamos a cargar todos estos ítems en nuestro listview y colorear según las siguientes condiciones:

  • si la edad es <= “25”  entonces el color de la fuente será una variedad de azul: RGB(0, 112, 192)
  • si la edad es > “45” entonces el color de la fuente será rojo (vbRed).
  • si es otra edad, el color será el establecido por defecto.

Para realizar todo esto utilizaremos este código vinculado a un botón de ejecución dentro del mismo formulario:

Option Explicit
Private Sub CommandButton1_Click()
'Definimos variables
Dim fin As Long, final As Long
Dim i As Long, j As Long, c As Long
Dim Dato As Object
fin = Application.CountA(Range("A:A"))
final = Application.CountA(Range("1:1"))
With ListView1
'Limpiamos los items del listview
.ListItems.Clear
'seleccionamos toda la línea
.FullRowSelect = True
'indicamos vista reporte
.View = lvwReport
With .ColumnHeaders
'Limpiamos y creamos encabezados
.Clear
.Add Text:="ID", Width:=30
.Add Text:="NOMBRE COMPLETO", Width:=160
.Add Text:="SECCIÓN", Width:=120
.Add Text:="EDAD", Width:=30
.Add Text:="SEXO", Width:=60
.Add Text:="2º IDIOMA", Width:=60
.Add Text:="ESTUDIOS", Width:=160
End With
'Cargamos datos de la hoja
'Si el valor es menor o igual a 25 años marcamos con color RGB
For i = 2 To fin
If Cells(i, 4).Value <= "25" Then
Set Dato = .ListItems.Add(Text:=Cells(i, 1).Value)
Dato.ForeColor = RGB(0, 112, 192)
With Dato.ListSubItems
For c = 2 To final
.Add Text:=Cells(i, c).Value
Next c
For j = 1 To .Count
.Item(j).ForeColor = RGB(0, 112, 192)
Next j
End With
'Si el valor es mayor que 45 años marcamos con color rojo
ElseIf Cells(i, 4).Value > "45" Then
Set Dato = .ListItems.Add(Text:=Cells(i, 1).Value)
Dato.ForeColor = vbRed
With Dato.ListSubItems
For c = 2 To final
.Add Text:=Cells(i, c).Value
Next c
For j = 1 To .Count
.Item(j).ForeColor = vbRed
Next j
End With
'caso contrario, no coloreamos
Else
Set Dato = .ListItems.Add(Text:=Cells(i, 1).Value)
With Dato.ListSubItems
For c = 2 To final
.Add Text:=Cells(i, c).Value
Next c
End With
End If
Next i
End With
End Sub

El resultado será el siguiente:

ITEMS EN LISTBOX CON COLORES. CONTROL LISTVIEW_3

Como podéis observar, cuando cargamos los datos se aplican los criterios de nuestra condición.

Y esto es todo!.

Descarga el archivo de ejemplo pulsando en: ÍTEMS EN LISTBOX CON COLORES. CONTROL LISTVIEW

¿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