Hola a todos:

Hace unos meses publiqué una entrada muy sencilla creando una función para sumar el contenido de un rango según el color de las celdas.

Este es el post: SUMAR DATOS EN UN RANGO SEGÚN EL COLOR DE LA CELDA

Hoy vuelvo con el mismo tema pero usando un nuevo método para obtener el mismo resultado, pero más eficiente y rápido.

En el post inicial usaba una instrucción For – Each para buscar y evaluar las celdas, esto que es perfectamente válido, no es tan eficiente como otras técnicas. Hoy lo vamos a hacer con el método RANGE.FIND, mucho más veloz, pero que no podremos usar como una UDF, sino como un procedimiento Sub.

Este es el código que vamos a usar:

Option Explicit
Sub SUMACOLOR()
'Declaramos variables
Dim Fin As Long, i As Long, acum, iniAddress As String
Dim MiSelect As Object, miColor As Object, RngCelda As Object
Dim ccolor As String
With ActiveSheet
Fin = Application.CountA(.Range("1:1"))
'Iniciamos loop para contar celdas con colores
For i = 6 To Fin + 1
acum = 0
Set MiSelect = selection
Set miColor = .Cells(2, i)
ccolor = miColor.Address
'Buscamos todas las celdas con los colores que hemos indicado y sumamos los valores siempre que celda tenga contenido y el formato indicado
Application.FindFormat.Interior.Color = Range(ccolor).Interior.Color
Set RngCelda = MiSelect.Find("*", after:=MiSelect.Cells(MiSelect.Rows.Count, MiSelect.Columns.Count), searchformat:=True)
If Not RngCelda Is Nothing Then
iniAddress = RngCelda.Address
Do
Set RngCelda = MiSelect.Find("*", after:=RngCelda, searchformat:=True)
acum = acum + IIf(IsNumeric(RngCelda), RngCelda, 0)
Loop Until RngCelda.Address = iniAddress
End If
.Cells(3, i) = acum
Next i
End With
End Sub

Y lo vamos a utilizar con el siguiente ejemplo:

Una vez que ejecutamos la macro:

Obtenemos el sumatorio de las celdas según el color:

Antes de ejecutar debéis seleccionar el rango sobre el que vais a contar según el color.

Y eso es todo, esta clase de programación os la dejo de cortesía, no se suele ver por los foros y redes, y aunque en este caso la aplico a esto, hace años que la uso para otras finalidades.

Descarga el archivo de ejemplo pulsando en: USAR MÉTODO RANGE.FIND PARA SUMAR EL CONTENIDO DE UN RANGO SEGÚN EL COLOR DE LAS CELDAS

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



¡¡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

Hola a todos:

Esta semana recibí una consulta sobre matrices (arrays) multidimensionales. En concreto sobre las matrices de 2 dimensiones, dado que la necesidad era para datos establecidos en una hoja Excel y los elementos o las dimensiones eran las filas y las columnas. La consulta era para saber cómo rellenar la matriz desde Excel.

Sobre matrices os dejo enlaces en microsoft y que creo que os pueden interesar interesantes:

• https://docs.microsoft.com/es-es/dotnet/visual-basic/programming-guide/language-features/arrays/
• https://docs.microsoft.com/es-es/office/vba/language/concepts/getting-started/using-arrays

Voy a ser breve con este ejemplo, porque lo que voy a realizar es el ejemplo de rellenar una matriz y pasar los datos de nuevo a Excel a otra hoja.

Vamos con el ejemplo:

La idea es leer todos estos datos, pasarlos a una matriz (MiArray) y pasarlos a la hoja2 de nuestros archivo de ejemplo. Esto lo vamos a realizar con el siguiente código:

Option Explicit
Sub ARRAY_MULTIDIMENSIONAL()
'Declaramos variables
Dim i As Long, j As Long, final As Long, fin As Long
Dim n As Long, x As Long
With Sheets(1)
'Capturamos límite de fila y columna
final = Application.CountA(Sheets(1).Range("1:1"))
fin = Application.CountA(Sheets(1).Range("A:A"))
'Redimensionamos nuestra matriz
ReDim MiArray(1 To fin, 1 To final)
'Rellenamos matriz
For i = 1 To fin
For j = 1 To final
MiArray(i, j) = Sheets(1).Cells(i, j)
Next j
Next i
End With
'Pasamos los datos de la matriz a la hoja2
For n = 1 To fin
For x = 1 To final
Sheets(2).Select
Sheets(2).Cells(n, x) = MiArray(n, x)
Next x
Next n
End Sub

El resultado es el esperado, los datos de la hoja1 pasan a la hoja2. Obviamente, este ejercicio es muy sencillo, pero es útil para saber cómo funciona y se comportan las matrices.

Si necesitamos modificar el contenido de lo que estamos pasando a la matriz, podemos utilizar condicionales o cualquier otra estructura para indicar mediante una regla qué datos deseamos modificar o leer.

Y esto ha sido todo, es un post corto, pero que aclara perfectamente cómo utilizar este tipo de matrices, cómo llenarlas, cómo leerlas y como “moverlas”.

Descarga el archivo de ejemplo pulsando en: MATRICES MULTIDIMENSIONALES EN VBA. EJEMPLO PRÁCTICO CON DOS DIMENSIONES

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



¡¡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

Hola a todos:

Estos días he estado trabajando con matrices y con cadenas (Strings) de contenido numérico para realizar una ordenación de sus componentes.

Teniendo en cuenta que no se puede utilizar el método “Range.Sort”, básicamente porque no trabajamos con un rango, y que tampoco se posible crear un objeto arrayList para utilizar el método Sort, dado que la ordenación cuando trabajamos con números no se adecúa al estándar habitual, dado que ordena de la siguiente forma forma: 1, 10, 2, 3 …

Entonces el único método posible para realizar la ordenación de forma correcta y sin márgenes de error, es el que se explica con el Algoritmo de Ordenación de Burbuja. Os dejo en link a la Wikipedia para que lo podéis comprender mejor.

En teoría se trata de ir comparando el número (n) si es mayor al siguiente (n+1), en caso de serlo, se intercambia el lugar de ambos en la cadena, en caso de no serlo, se evalúa el siguiente y así hasta finalizar. He tomado el gif de la wikipedia para ilustrar gráficamente el comportamiento:

Esta programación ya la he usado en varias ocasiones y me pareció interesante mostrar cómo se hace en VBA. Veamos un ejemplo:

Lo que queremos obtener es la ordenación de todos estos números y de paso, obtener el número menor y el mayor. Para realizar esto, vamos a utilizar la siguiente macro:

Sub Ordenar_String()
'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
'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)
'Una vez que tenemos el array ordenado,
'Extraemos el valor mínimo y el máximo
Valores = Split(Join(miArray, " "), " ")
For n = LBound(Valores) To UBound(Valores)
If n = LBound(Valores) Then Min = Valores(n)
If n = UBound(Valores) Then Max = Valores(n)
Next n
'Mostramos el máximo y el mínimo y mostramos todos los números ordenados.
Mensaje = MsgBox("El valor mínimo es: " & Min & " y el valor máximo es: " & Max, vbYesNo, "¿Quieres el detalle, pulsa en Si?")
If Mensaje = vbYes Then Listado = MsgBox(Join(miArray, " "), vbInformation, "LISTADO DE NÚMEROS")
End Sub

Si estudiáis bien el código, la parte fundamental, (el algoritmo), es este:

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)

Es aquí donde realizamos la tarea de comprar todos los números y ordenarlos de la forma que os describí anteriormente.

El resultado es el siguiente:

Y este es el resultado, he programado la macro para que muestre la cadena ordenada en un msgbox, pero con un sencillo loop lo podéis pasar a la hoja activa.

Si por alguna razón los datos que estáis mostrando en el msgbox son muchos y por limitaciones no muestra todos, podéis usar lo siguiente:

If Mensaje = vbYes Then
With CreateObject("wscript.shell")
.Popup MiCadena
End With

en lugar de:

If Mensaje = vbYes Then Listado = MsgBox(Join(miArray, " "), vbInformation, "LISTADO DE NÚMEROS")

Y eso es todo, ahora ya sabéis cómo programar un algoritmo de ordenación, en este caso el de Burbuja. Y como siempre, os dejo el ejemplo.

Descarga el archivo de ejemplo pulsando en: ALGORITMO DE ORDENACIÓN DE BURBUJA EN VBA

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



¡¡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

Hola a todos!.

Espero que estéis bien!, hoy os voy a dejar una macro que creé para responder a una consulta.

Se trata de mostrar las propiedades que tiene uno o varios archivos en una hoja, es decir, listarlos y mostrar los datos. Esto ya lo realicé en una ocasión con este post: LISTAR LAS PROPIEDADES DE TODOS LOS ARCHIVOS DE UNA CARPETA Y SUBCARPETAS

Pero a diferencia del post anterior, lo que necesita el lector es que pueda seleccionar los archivos y no la carpeta con todo su contenido. Esto es algo bastante razonable, así que le mostré una posible solución.

Imaginad que queremos listar estos archivos, pero no todo el contenido de la carpeta, solo los archivos de Excel:

Pues con este código lo vamos a lograr:

Sub LISTAR_ARCHIVOS()
'Definimos variables
Dim i As Long, j As Long, FSO As Object
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", 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
'Creamos FileSystemObject para obtener propiedades de cada archivo seleccionado
Set FSO = CreateObject("Scripting.FileSystemObject")
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
'Pasamos propiedades de cada archivo a la hoja
.Cells(i, 2) = FSO.GetFile(nArchivo).DateCreated
.Cells(i, 3) = FSO.GetFile(nArchivo).DateLastAccessed
.Cells(i, 4) = FSO.GetFile(nArchivo).DateLastModified
.Cells(i, 5) = FSO.GetFile(nArchivo).Type
.Cells(i, 6) = FSO.GetFile(nArchivo).Size
Next j
End With
End Sub

Después de seleccionar los archivos, el resultado es el siguiente:

Como podéis observar, tenemos los archivos seleccionados, con su hipervínculo al lugar del equipo en el que los tenemos y algunas de sus propiedades, tamaño, fecha creación, modificación, etc.

Y eso es todo, espero que os resulte interesante y lo podáis utilizar en vuestros proyectos.

Descarga el archivo de ejemplo pulsando en: MOSTRAR PROPIEDADES DE ARCHIVOS SELECCIONADOS

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



¡¡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

Hola a todos:

Hoy os voy a mostrar una forma de programar hipervínculos que estoy seguro os parecerá interesante. La idea es la de crear un proceso dinámico y automático y no solo conformarnos con invocar el método Hyperlink.

Por ejemplo, se me ocurre que si escribo una serie de lugares en mi hoja Excel y decido crear una ruta de viaje, si seleccionase esas celdas podría mostrar esa información en un navegador (el que tenga definido como predeterminado) con google maps.

Vamos a ver un ejemplo:

Estas son las rutas de viaje que me he propuesto y con las que casi voy a dar la vuelta a España, gran viaje!!

Para poder hacerlo y llevarlo a cabo os mostraré el código que voy a utilizar:

Sub MAPA()
'Declaramos las variables
Dim Matriz As Object, Palabra As Variant, Area As Object
Dim alfaDato As Variant, iPalabra As String
'Creamos colección arraylist para ir agregando los elementos de la matriz
Set Matriz = CreateObject("System.Collections.ArrayList")
'Trabajamos con la hoja activa
With ActiveSheet
Set Area = Application.Intersect(Selection, .UsedRange)
'Controlamos que existan datos seleccionados
On Error GoTo Control
'Por cada objeto/palabra del rango seleccionado
For Each Palabra In Area
'Añadimos cada palabra a la matriz con un loop
Matriz.Add Palabra
Next Palabra
'Pasamos los datos a una cadena de texto
For Each alfaDato In Matriz
iPalabra = iPalabra & "/" & alfaDato
Next alfaDato
OrdenarAlfa = Trim(iPalabra)
'Abrimos explorador y mostramos la ruta
Url = "https://www.google.com/maps/dir" & OrdenarAlfa
ActiveWorkbook.FollowHyperlink Url, NewWindow:=False
'mostramos mensaje de error
Control: If Err.Number = "424" Then
MsgBox ("EL RANGO O LAS CELDAS SELECCIONADAS NO CONTIENEN DATOS"), vbExclamation, "SIN DATOS SELECCIONADOS"
End If
'Limpiamos variable de objeto
Set Matriz = Nothing
Set Area = Nothing
End With
End Sub

Como podéis ver, además del método Workbook.FollowHyperlink tambíen he introducido la creación de una cadena y una matriz con los datos seleccionados.

Este método os puede servir para muchos trabajos de programación en Excel y otros lenguajes.

El resultado es este, unas 34 horas de viaje y unos cuantos sitios que visitar : )

Este ejercicio es meramente orientativo y para que aprendáis cómo podemos utilizar y programar los hipervínculos en Excel.

Y eso es todo, ¿os parece interesante?.

Descarga el archivo de ejemplo pulsando en: PROGRAMAR HIPERVÍNCULOS EN VBA. EJEMPLO PRÁCTICO CON GOOGLE MAPS

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



¡¡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