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

Hola a todos!

En el post de hoy voy a responder a un lector la siguiente consulta relacionada con este antiguo post: ELIMINAR FILAS VACÍAS CON VBA EN EXCEL

Esta es la consulta: “Gracias por Compartir. Está excelente. La ejecuté y funciona perfecto para rangos cuyas filas vacías están definidas desde la columna “A”. Pero, ¿cómo hacer para eliminar filas vacías cuando en un rango, por ejemplo desde Columna A hasta Columna BH, tengo columnas que contienen datos, es decir no están “totalmente vacías”, es decir quiero eliminar sólo Filas “totalmente vacías”.
Nuevamente, Gracias! y feliz 2020!”

Pues bien, ayer propuse la siguiente solución:

Option Explicit
Sub ELIMINAR_FILAS_VACIAS()
'Declaramos variables
Dim Fin As Long, i As Long
Dim fila As String, rFila As String
Dim sFilas As String, Control As Long
With ActiveSheet
'Detectamos última columna con datos por cada fila
Fin = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To Fin
'Si la suma de la fila es igual a cero,está vacía
Control = Application.CountA(.Range("A" & i & ":" & "BH" & i))
'Control = Application.CountA(.Range(i & ":" & i))

If Control = 0 Then
'Componemos rango de filas con un arraystring
fila = i & ":" & i
rFila = rFila & "," & fila
End If
Next i
'Seleccionamos todas las filas detectadas y las eliminamos
sFilas = Mid(rFila, 2, Len(rFila))
If sFilas <> vbNullString Then
Range(sFilas).Select
Selection.Delete
End If
End With
End Sub

Este código funciona correctamente hasta un determinado límite, en concreto los 255 caracteres como límite a la hora de componer el arraystring. Aunque normalmente trato de verificar estas limitaciones antes de publicar un post, lo cierto es que ha sido un lector de LinkdIn: Tomasz Władysław Głuszkowski quien me advirtió del problema (Muchas gracias!)

Por eso, voy a proponer otro código distinto:

Option Explicit
Sub ELIMINAR_FILAS_VACIAS()
'Declaramos variables
Dim r As Long
Dim Control As Long
With ActiveSheet
'Iniciamos loop
r = 1
Do Until r = .Cells(Rows.Count, 1).End(xlUp).Row
Control = Application.CountA(.Range(Cells(r, 1).Row & ":" & Cells(r, 1).Row))
'Control = Application.CountA(.Range("A" & Cells(d, 1).Row & ":" & "BH" & Cells(d, 1).Row))
'Si variable control es 0 entonces eliminamos fila
If Control = 0 Then
Rows(r).Delete
Else
'Si no es 0 seguimos con la fila siguiente
r = r + 1
End If
Loop
End With
End Sub

En esencia realiza la misma función aunque utilizamos un loop do – until para eliminar las filas, en lugar de componer el array y seleccionar el rango.

Por ejemplo, tenemos este listado, en verde he marcado las filas que debe desaparecer:

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

Y este es el resultado:

ELIMINAR FILAS VACÍAS SI TODAS LAS CELDAS DEL RANGO ESTÁN EN BLANCO_1

Y eso es todo, espero que la respuesta sea de utilidad!.

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

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

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

FUNCIÓN PARA EXTRAER REGISTROS ÚNICOS DE UN RANGO

Hola a todos!.

Qué tal estáis? supongo que disfrutando de los últimos días del año!.

Hoy os voy a dejar un código para crear una UDF que sea capaz de extraer los registros únicos de un rango determinado. Aunque ya os había propuesto una macro parecida aquí: EXTRAER REGISTROS ÚNICOS DE UN RANGO DE DATOS

En este código lo vamos a hacer con una función y utilizando un método distinto. La principal diferencia es que el resultado de la función lo vamos a llevar a una celda y no de nuevo a un rango.

Veamos el código:

Option Explicit
Function UNICOS(ByVal Target As Range, delimitador As String)
'Declaramos variables
Dim oDic As Object
Dim Micelda As String, matrix1 As Variant
Dim i As Long, Unico As String, celda As Variant
With Sheets("Hoja1")
'Creamos objeto diccionario
Set oDic = CreateObject("scripting.dictionary")
'Componemos string con el rango seleccionado
For Each celda In Target
If celda <> vbNullString Then
Micelda = Micelda & delimitador & celda
matrix1 = Split(Micelda, delimitador)
End If
Next celda
'Eliminamos números o letras repetidos
For i = 0 To UBound(matrix1)
If Not oDic.Exists(matrix1(i)) Then oDic.Add matrix1(i), matrix1(i)
Next i
'Extraemos registros únicos con el delimitar elegido
Unico = Mid(Join(oDic.keys, delimitador), Len(delimitador) + 1, Len(Join(oDic.keys, delimitador)))
UNICOS = Unico
End With
'Vaciamos variable de objeto
Set oDic = Nothing
End Function

¿Que resultado conseguimos con este código?, pues este:

Primero seleccionamos el rango e indicamos el delimitador que queremos entre los registros que hemos extraído:

FUNCIÓN PARA EXTRAER REGISTROS ÚNICOS DE UN RANGO

El resultado es este:

FUNCIÓN PARA EXTRAER REGISTROS ÚNICOS DE UN RANGO_1.jpg

Como podéis observar, la función nos ofrece el resultado esperado y en un tiempo razonable. Si necesitáramos pasar los datos a un rango os recomiendo la funcionalidad texto en columnas, en la función no se puede realizar (solo aplicando la función matricialmente, y para eso lo podemos lograr con una fórmula).

Y eso es todo, espero que os resulte de utilidad.

Descarga el archivo de ejemplo pulsando en: FUNCIÓN PARA EXTRAER REGISTROS ÚNICOS DE 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

SELECCIONAR ARCHIVOS DE UNA CARPETA Y ENVIARLOS POR OUTLOOK SEGÚN EL NOMBRE DE LA CARPETA

Hola a todos!:

Parece que este 2019 ya se va apagando poco a poco!. Y en breve estaremos iniciando el 2020. Espero que todo nos vaya muy bien y se cumplan nuestros sueños y proyecto.

Mientras tanto, voy a escribir un post como respuesta a una consulta:

Hola Segu, una duda, necesito hacer estos envios, pero en lugar de tener el nombre de los aduntos, lo que tengo es el nombre de las carpetas. Mi macro debe recorrer esos nombres, ir abriendo cada carpeta y adjuntando para cada persona todos los archivos que contengan esas rutas.

Es decir, para el destinatario “MANUEL” tengo que ir a la carpeta en ruta que se llame Manuel y enviar en un correo todos los archivos contenidos en esa ruta..

No consigo que me adjunte los archivos..

¿Puedes ayudarme? Gracias

Esta consulta viene como referencia a un post inicial en el que programé un procedimiento automático de envío de archivos según los tengamos detallados en nuestra hoja Excel. Este es el post: SELECCIONAR ARCHIVOS DE UNA CARPETA Y ENVIARLOS POR OUTLOOK SEGÚN CATÁLOGO DE INFORMES

En este caso, lo que el lector solicita es que el código recorra todas las carpetas y cuando se encuentra con las que hemos indicado, adjunte en para cada nombre/carpeta todo el contenido de la misma en el correo de outlook.

Vamos a aprovechar la macro del proceso anterior y modificar algunas rutinas para realice lo que necesitamos:

Sub ENVIAR_CORREOS()
'Declaramos variables
Dim sFSO As Object, Directorio As String
Dim dir_Archivo As Variant
'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
Directorio = dir_Archivo.SelectedItems(1)
'Creamos objeto y ejecutamos función Carpeta
Set sFSO = CreateObject("Scripting.FileSystemObject")
CARPETA sFSO.GetFolder(Directorio)
End Sub

Function CARPETA(ByVal nCarpeta)
'Declaramos variables
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim fin As Long, i As Long, File As Variant
Dim adjunto As String, nFile As String
Dim olMailItem As Variant, Celda As Variant
'Iniciamos función
With Sheets("Hoja1")
fin = Application.CountA(.Range("A:A"))
'recorremos hoja y celda para comprobar si hace
'referencia a varios archivos.
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(olMailItem)
'Recorremos todas las carpetas y subcarpetas
For Each subcarpeta In nCarpeta.SubFolders
CARPETA subcarpeta
Next subcarpeta
For i = 2 To fin
'Si la carpeta se llama igual a la que tenemos en la hoja
'Adjuntamos todo su contenido
If .Cells(i, 1) = nCarpeta.Name Then
For Each File In nCarpeta.Files
adjunto = File
nFile = Left(File.Name, InStr(File.Name, ".") - 1)
'Destinatario
olMail.To = .Cells(i, 2)
'Con copia a
olMail.CC = .Cells(i, 3)
'Con copia oculta
olMail.BCC = .Cells(i, 4)
'Asunto
olMail.Subject = .Cells(i, 1)
'Cuerpo de correo
olMail.HTMLBody = "Buenos días:
Les enviamos los archivos solicitados.
Atentamente."
' Adjuntamos archivo y dejamos correo en bandeja de salida
olMail.Attachments.Add (adjunto)
'Para enviar debéis utilizar Send en lugar de Display
'olMail.Send
olMail.Display
Next File
End If
Next i
olMail: Close
olApp: Close
End With
Set olMail = Nothing
Set olApp = Nothing
End Function

A diferencia del post anterior, en este caso vamos a recorrer todas las carpetas y subcarpetas hasta encontrar la que coincida con la hemos especificado en la hoja. En el momento que lo haga adjuntaremos todos los archivos a Outlook.

Por ejemplo, si elijo uno de mis post (donde guardo todos los archivos con los que escribo la entrada, imágenes, excel, etc):

SELECCIONAR ARCHIVOS DE UNA CARPETA Y ENVIARLOS POR OUTLOOK SEGÚN EL NOMBRE DE LA CARPETA

Y esta sería la carpeta:

SELECCIONAR ARCHIVOS DE UNA CARPETA Y ENVIARLOS POR OUTLOOK SEGÚN EL NOMBRE DE LA CARPETA_1

Con un total de 6 archivos que tendríamos que adjuntar. Si ejecutamos la macro y seleccionamos la carpeta en la que se encuentran los datos, generaremos el siguiente email:

SELECCIONAR ARCHIVOS DE UNA CARPETA Y ENVIARLOS POR OUTLOOK SEGÚN EL NOMBRE DE LA CARPETA_2

Como podéis observar, aquí tenemos el correo con todos los adjuntos de la carpeta que hemos indicado.

Y esta ha sido la contestación a la consulta, espero que también a vosotros os sea de utilidad para vuestros procedimientos de envío.

Descarga el archivo de ejemplo pulsando en: SELECCIONAR ARCHIVOS DE UNA CARPETA Y ENVIARLOS POR OUTLOOK SEGÚN EL NOMBRE DE LA CARPETA

¿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

GENERAR UN PATRÓN NUMÉRICO CON MATRICES BIDIMENSIONALES EN VBA

Hola a todos!.

Espero que estéis pasando unos buenos días de descanso durante este puente de la Constitución!.

Hoy ha decidido escribir un pequeño post sobre los patrones numéricos y una forma de generar uno en particular. Se trata del siguiente (aunque puede tener muchas variaciones): 123 212 321 o lo que es lo mismo pero visualmente en Excel:

GENERAR UN PATRÓN NUMÉRICO CON MATRICES BIDIMENSIONALES EN VBA

Podéis verlo perfectamente, y además me he permitido utilizar el formato condicional para colorear el área, generando así una secuencia mucho más visual, fijaros en el número 1, (verde) cómo se repita y cruza la diagonal. Esto lo podremos hacer de distintos tamaños, por ejemplo, de 20X20:

GENERAR UN PATRÓN NUMÉRICO CON MATRICES BIDIMENSIONALES EN VBA_1

Y ¿cómo generamos este patrón?, aquí el código:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Declaramos variables
Dim Mensaje As String, Titulo As String, MiArea As Variant
Dim i As Long, j As Long, celda As String
'Con un inputbox determinamos las dimensiones de nuestro cubo
Mensaje = "Introduce un número que será el alto y ancho del cubo que vamos a crear, por ejemplo el 20 para ser 20X20"
Titulo = "AREA DEL CUBO"
MiArea = InputBox(Mensaje, Titulo)
If StrPtr(MiArea) = 0 Then Exit Sub
'Mediante dos bucles anidados generamos una matriz de dos dimensiones
'que realizará la inversión de los dígitos generados en la primera columna
ReDim MiRango(0 To MiArea, 0 To MiArea)
MiRango(0, 0) = 1
For i = 1 To MiArea
MiRango(i, 0) = MiRango(i - 1, 0) + 1
MiRango(0, i) = MiRango(0, i - 1) + 1
For j = 1 To MiArea
MiRango(i, j) = MiRango(i - 1, j - 1)
MiRango(j, i) = MiRango(j - 1, i - 1)
Next j
Next i
'Pasamos los datos desde la celda activa con dobleclick
celda = ActiveCell.Address
Range(celda).Resize(MiArea, MiArea).Value = MiRango
End Sub

Como podéis observar utilizamos una matriz de dos dimensiones (necesaria) para crear esta secuencia, dado que necesitamos tener en cuenta filas y columnas. Las matrices se rellenan mediante dos loop anidados e incrementando +1 en cada fila y columna.

Podemos modificarlos y multiplicarlo por 2, por 3 etc o hacerlo en las diagonales (j) y el patrón sería distinto.

Para que no tengáis que ir modificando el área del cubo, os he creado en la macro un inputbox para indicarlo antes de pasar los datos a la hoja.

Y esto es todo, este es un ejercicio para que veais no solo cómo se puede crear este patrón, sino como podemos rellenar y generar una matriz bidimensional y (importate), pasarla a la hoja.

Descarga el archivo de ejemplo pulsando en: GENERAR UN PATRÓN NUMÉRICO CON MATRICES BIDIMENSIONALES 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

OBTENER CÓDIGO RGB DE LA PALETA DE COLORES DE EXCEL CON VBA

Hola a todos:

En principio este fin de semana no tenía pensado escribir ningún post, he estado bastante liado con temas personales y realmente el viernes me encontraba agotado y con ganas de descansar.

Pero hoy estoy un poco más libre y tengo una hora suelta para escribir un post. Hoy os quiero mostrar una forma de obtener el código RGB de cualquier color que forme parte de la paleta de colores de Excel.

Hace unas semanas escribí una entrada sobre cómo GENERAR PALETA DE COLORES CON VBA  era un ejercicio muy sencillo que tenía como objetivo el poder generar la paleta de colores, y además el de modificar un loop para recorrer determinado rango de filas y columnas.

Hoy voy a tratar de completar aquel trabajo inicial con unas líneas de código que nos servirán para mostrar el RGB.

En rojo están los cambios fundamentales.

'Option Explicit
Sub PALETA_COLOR()
'Definimos variables
Dim CONT As Integer, COL As Integer, i As Integer, Control As String
Dim Rojo As String, Verde As String, Azul As String
'Inicializamos proceso
CONT = 1
COL = 1
'Creamos loop para colorear celda con cada color index
'Cada 6 celdas seguimos el loop en la columna siguiente
For i = 1 To 56
If CONT <= 5 Then
'Aplicamos color
Cells(CONT, COL).Interior.ColorIndex = i
'Obtenemos RGB
Control = WorksheetFunction.Rept("0", 6 - Len(Hex(Cells(CONT, COL).Interior.Color))) & Hex(Cells(CONT, COL).Interior.Color)
Rojo = Application.WorksheetFunction.Hex2Dec(Right(Control, 2))
Verde = Application.WorksheetFunction.Hex2Dec(Mid(Control, 3, 2))
Azul = Application.WorksheetFunction.Hex2Dec(Left(Control, 2))
Cells(CONT, COL).Value = Rojo & "|" & Verde & "|" & Azul
Cells(CONT, COL + 1).Value = "Color: " & i
CONT = CONT + 1
Else
'Aplicamos color
Cells(CONT, COL).Interior.ColorIndex = i
'Obtenemos RGB
Control = WorksheetFunction.Rept("0", 6 - Len(Hex(Cells(CONT, COL).Interior.Color))) & Hex(Cells(CONT, COL).Interior.Color)
Rojo = Application.WorksheetFunction.Hex2Dec(Right(Control, 2))
Verde = Application.WorksheetFunction.Hex2Dec(Mid(Control, 3, 2))
Azul = Application.WorksheetFunction.Hex2Dec(Left(Control, 2))
Cells(CONT, COL).Value = Rojo & "|" & Verde & "|" & Azul
Cells(CONT, COL + 1).Value = "Color: " & i
CONT = 1
COL = COL + 2
End If
Next i
End Sub

Lo que hacemos en cada una de las variables en las que almacenamos el número del color es:

En primer lugar pasar el número que se obtiene Interior.Color a la función Hex con la obtendremos una string representando su valor Hexagesimal. Y que debe contener 6 posiciones, con 0 hasta llegar al final.

WorksheetFunction.Rept("0", 6 - Len(Hex(Cells(CONT, COL).Interior.Color))) & Hex(Cells(CONT, COL).Interior.Color)

A continuación, por cada color extraemos parte del código que vamos a pasar a Dec con la función Hex2Dec

Ese valor será parte de los tres colores para componer nuestro código RGB.

El resultado es:

OBTENER CODIGO RGB DE LA PALETA DE COLORES DE EXCEL

Y eso es todo, espero que os sea de utilidad!!

Descarga el archivo de ejemplo pulsando en: OBTENER CÓDIGO RGB DE LA PALETA DE COLORES CON 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

USAR MÉTODO RANGE.FIND PARA SUMAR EL CONTENIDO DE UN RANGO SEGÚN EL COLOR DE LAS CELDAS

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:

USAR MÉTODO RANGE.FIND PARA SUMAR EL CONTENIDO DE UN RANGO SEGÚN EL COLOR DE LAS CELDAS

Una vez que ejecutamos la macro:

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

USAR MÉTODO RANGE.FIND PARA SUMAR EL CONTENIDO DE UN RANGO SEGÚN EL COLOR DE LAS CELDAS_1

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.

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

MATRICES MULTIDIMENSIONALES EN VBA. EJEMPLO PRÁCTICO CON DOS DIMENSIONES

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:

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:

MATRICES MULTIDIMENSIONALES EN VBA. EJEMPLO PRÁCTICO CON DOS DIMENSIONES

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.

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