martes, 12 de marzo de 2019

VBA: Extraer elementos de las diagonales de una matriz

Hoy construiremos una macro para extraer los distintos elementos que componen la diagonal de un elemento seleccionado en una matriz...
Se trata de dar una posible solución a un lector que preguntaba:
[...]Tengo una matriz en Excel de 5x5
por favor me ayudan con una forma de extraer todas las diagonales y saber cuales son los números que le corresponden cada ubicación.
1 2 3 4 5
6 7 8 9 10
11 12 13 14 15
16 17 18 19 20
21 22 23 24 25

Hay unas particularidades con los números 3, 6, 13, 19
las casillas que le corresponden a las diagonales del 3 son ( 3, 7,11,9 y 15)
las casillas que le corresponden a las diagonales del 6 son ( 6,2,12,18, y 24)
las casillas que le corresponden a las diagonales del 13 son ( 1,7,13,19, y 25)
las casillas que le corresponden a las diagonales del 19 son ( 1,7,13,19, 25,23 y 15)[...]

VBA: Extraer elementos de las diagonales de una matriz



El funcionamiento será simple, sobre una matriz de cualquier dimensión (en el ejemplo 5x5), seleccionamos un único elemento... y tras presionar el botón que ejecuta la macro, obtendremos todos los elementos de las diagonales
de dicho elemento.


Insertamos un módulo estándar, y en esta ventana de código añadiremos nuestra macro:

Sub Diagonales()
'www.excelforo.com
Dim myRange As Range
Set myRange = Selection.CurrentRegion

Dim iniFil As Long, iniCol As Long, finFila As Long, finCol As Long, i As Long
iniFil = myRange.Row
iniCol = myRange.Column
finFila = myRange.Rows.Count + iniFil - 1
finCol = myRange.Columns.Count + iniCol - 1

Dim numFil As Long, numCol As Long
'contamos número de filas y columnas de la matriz
numFil = myRange.Rows.Count
numCol = myRange.Columns.Count

Dim celdaIni As Range
Dim fil As Long, col As Long
'una sola celda seleccionada dentro de la matriz de datos!!
Set celdaIni = Selection
fil = celdaIni.Row - iniFil + 1
col = celdaIni.Column - iniCol + 1

Dim delta As Long

Dim elementos() As Long
Dim columna As Long, fila As Long   'para identificar los elementos que cumplan..
Dim n As Long
n = 0
'recorremos cada elemento de la matriz
'por fila y luego por columna
For f = 1 To numFil
        For c = 1 To numCol
            delta = col - fil   'valor de ajuste según posición inicial en la matriz
            'me compara con la posición de la celda seleccionada
            If c = (fil - Abs(fil - f) + delta) Or c = (fil + Abs(fil - f) + delta) Then
                n = n + 1
                'añadimos elemento que pertenezca a su diagonal
                ReDim Preserve elementos(n)
                elementos(n) = myRange.Cells(f, c).Value
            End If
        Next c
Next f

'llevamos los elementos a la hoja de cálculo...
Range("J1:J99").Clear   'Limpia el destino...
For i = 1 To n
    Range("J1").Offset(i - 1, 0).Value = elementos(i)
Next i

End Sub



El algoritmo es simple... de especial relevancia el empleo de ReDim Preserve para cargar los elementos de las diagonales... un número de elementos a priori desconocido.

4 comentarios:

  1. Muchas gracias `por su aporte, excelente

    ResponderEliminar
  2. Buen dia,

    Ismael Romero. Quiero pedirle el favor de construir un macro para buscar y resaltar en una matriz de 4 columnas y n filas, los números en diagonales, verticales y horizontales según el criterio:

    A B C D
    7 4 6 0
    7 0 7 2
    1 1 7 4
    2 1 7 7
    1 1 7 8
    7 3 7 2
    En este caso que se coloree de verde las celdas que con forme el 712 de manera horizontal, vertical diagonal (todos pueden ser invertidas) en este ejemplo el criterio se cumple 5 veces,

    Si buscara 1172 el criterio se cumpliría 2 veces.

    agradezco su valioso aporte

    ResponderEliminar
    Respuestas
    1. Hola Gilbert,
      le daré una vuelta y pensaré cómo desarrollar algo al respecto

      Aunque el asunto parece delicado... y desde luego fuera del propósito de las dudas a plantear en los comentarios (ver Normas de uso del blog)

      Un cordial saludo

      Eliminar

Nota: solo los miembros de este blog pueden publicar comentarios.