domingo, 29 de noviembre de 2020

Sumar las celdas de la diagonal de una tabla

Puede descargar el archivo suma_diagonal.xlsm

Deseamos sumar los valores de las celdas de la diagonal de una tabla. La tabla que usamos de ejemplo está formada por números aleatorios que varían si pulsamos la tecla F9 de recálculo manual.

Con la función INDIRECTO

Vamos a resolverlo utilizando la función INDIRECTO.






En este ejemplo la celda de la primera esquina (celda D6) se encuentra en la fila 6, columna 4, por lo que en la función INDIRECTO  de la celda O2 hemos tenido que restar -2.

=INDIRECTO("F"&FILA()&"C"&FILA()-2;0)

Si la tabla estuviera en otro sitio y la primera esquina estuviera en la columna 10 tendríamos que sumar 4.  Veamos el motivo:

Si la celda de la primera esquina es la celda J6 los valores serían
  • Fila 6
  • Columna 10
  • Tendremos que sumar: 10 - 6 = 4

Con Macro

Podemos crear una macro utilizando código VBA para Excel que nos pregunte por los dos extremos de la diagonal. Primero nos preguntará por la esquina superior izquierda de la tabla.


Luego nos preguntará por la esquina inferior derecha de la tabla.


La tabla ha de ser cuadrada, en nuestro ejemplo estamos trabajando con una tabla 10x10. Se trata de una tabla de 10 filas y 10 columnas, que tendrá necesariamente 10 celdas en la diagonal.




Veamos el código del procedimiento que permite realizar la suma de la diagonal proporcionando las dos esquinas.

 Sub Informa_suma_diagonal()  
 Dim total, E1 As Range, E2 As Range  
 Dim i As Long, fila As Long, columna As Long  
 Set E1 = Application.InputBox(prompt:="Seleccione la celda superior izquierda de la tabla." & _  
  vbLf & "La tabla debe ser cuadrada.", Title:="Suma de la diagonal de una tabla", Type:=8)  
 'el 8 se usa cuando se toma una referencia a una celda como un objeto Range  
 Set E2 = Application.InputBox("Seleccione la celda inferiror derecha de la tabla." & _  
  vbLf & "Las dos esquinas de la tabla deben estar en la misma diagonal.", "Suma de la diagonal de una tabla", , , , , , 8)  
 If E2.Row - E1.Row <> E2.Column - E1.Column Then 'si la tabla no es cuadrada finaliza el programa  
   MsgBox "ERROR: estas dos esquinas no pertenecen a la misma diagonal." & _  
    vbLf & "El programa finalizará.", , "Suma de la diagonal de una tabla"  
   End 'finaliza la ejecución del programa ya que se ha detectado un error  
 End If  
 total = 0  
 For i = 1 To E2.Row - E1.Row + 1 'hasta el número de elementos de la diagonal  
   fila = E1.Row + i - 1 'contador de fila que comienza en la fila de la esquina superior izquierda  
   columna = E1.Column + i - 1 'contador de columna que comienza en la columna de la esquina superior izquierda  
   total = total + Cells(fila, columna).Value  
 Next i  
 MsgBox "La suma de la diagonal es " & total, , "Suma de la diagonal de una tabla"  
 End Sub  



Con función programada

Posiblemente es más útil trabajar con una función creada por el usuario. La función tiene dos parámetros que son las dos esquinas de la diagonal.
  • Esquina_1 es la esquina superior izquierda de la diagonal
  • Esquina_2 es la esquina inferior derecha de la diagonal
Si las dos celdas que se proporcionan no están en la misma diagonal se mostrará un aviso de error diciendo:

ERROR: no diagonal

 Function SumaDiagonal(Esquina_1 As Range, Esquina_2 As Range) As Variant  
 Dim total As Double  
 Dim i As Long, fila As Long, columna As Long  
 total = 0  
 For i = 1 To Esquina_2.Row - Esquina_1.Row + 1  
   fila = Esquina_1.Row + i - 1  
   columna = Esquina_1.Column + i - 1  
   If Application.WorksheetFunction.IsNumber(Cells(fila, columna).Value) Then  
     total = total + Cells(fila, columna).Value  
   End If  
 Next i  
 If Esquina_2.Row - Esquina_1.Row <> Esquina_2.Column - Esquina_1.Column Then  
   SumaDiagonal = "ERROR: no diagonal"  
 Else  
   SumaDiagonal = total  
 End If  
 End Function  

Alternativa propuesta

Le propongo que intente crear una macro que ponga de color amarillo, o el que usted prefiera, las celdas de la diagonal de una tabla. A la macro la tendríamos que proporcionar las dos esquinas de la diagonal, o bien, seleccionar una única celda de la tabla y luego que se señalara toda la tabla, tal como hace el atajo de teclado CONTRO+SHIFT+* de esta forma podríamos ahorrar que la macro nos pida parámetros.

Luego tendríamos que usar las ideas que se proporcionan en el siguiente post del blog:

jueves, 27 de agosto de 2020

Extraer elementos aleatoriamente sin repetición

Puede descargar el archivo extrae_aleatoriamente.xlsm

Disponemos de una columna con datos y queremos extraer en otra columna una serie de datos elegidos de forma aleatoria.




Pasos a seguir

  1. En la celda amarilla (E4) escribimos cuantos datos queremos extraer. El número puede variar entre 1 y 20. No olvidar pulsar ENTER después de introducir el número.
  2. Pulsamos sobre el botón que lanza la macro: donde pone Extraer en rojo.
  3. Con esto ya tendremos una extracción. Pulsando el botón de la macro podremos extraer otra nueva muestra aleatoria.

Código

El código contiene dos partes.
  • Para manejar la celda amarilla hemos creado un código que maneja un evento. Además la celda amarilla está tratada con Datos/Validación para que únicamente admita números enteros entre 1 y 20.
 Private Sub Worksheet_Change(ByVal Target As Range)  
 Worksheets("Hoja1").Activate  
 If Not Intersect(Target, Range("E4")) Is Nothing Then  
   Target.Interior.ColorIndex = 45  
   Range("E7:G26").ClearContents  
   For i = 1 To Target  
     Cells(i + 6, 5) = i  
   Next i  
 End If  
 End Sub  
  • Para la macro que se lanza con el botón hemos creado un procedimiento en VBA que se basa en la idea siguiente. Metemos la columna con los datos de entrada en la matriz A(). Creamos la matriz B() con un listado de los números desde el 1 hasta el 20, ordenados. Nos metemos en un bucle For que recorre la matriz B() comenzando por el final, desde la posición 20 hasta la posición 2. Por cada ciclo del bucle va permutando el valor de esa posición, inicialmente B(20), luego B(19), y así hasta llegar a la última con la que se trabaja que es B(2), con alguno de los valores previos elegidos aleatoriamente. Por ejemplo, el valor de B(20) se permuta con B(7), luego B(19) se permutará con B(15), etc., hasta llegar a B(2) cuyo valor se permutará con B(1). Para hacer estas permutaciones necesitaremos la variable auxiliar aux.
Es una forma curiosa de barajar las cartas de una baraja, y nos ha permitido crear un algoritmo eficiente. Al final del bucle For obtendremos una matriz B() perfectamente aleatorizada. En el último bucle For lo que hacemos es mostrar en la columna G los valores extraidos simplemente consultando las posiciones correspondientes de la matriz A().

 Option Explicit  
 Option Base 1  
 Sub extrae()  
 Dim num_datos As Long  
 Dim num_extraidos As Long  
 Dim rango_origen As Range  
 Dim A()  
 Dim B() As Long          'contiene los números del 1 hasta num_datos, inicialmente ordenados  
 Dim i As Long, r As Long, aux  
 num_extraidos = [E4]  
 Set rango_origen = Range("C7:C26") '<-- El usuario debe cambiar este valor por el de su caso  
 num_datos = rango_origen.Count  
 ReDim B(num_datos)  
 For i = 1 To num_datos  
   B(i) = i            'asignamos a B() los números del 1 hasta num_datos  
 Next i  
 A = rango_origen  
 Randomize  
 'vamos a desordenar los valores de la matriz B()  
 For i = num_datos To 2 Step -1   'i varia disminuye desde n hasta 2  
   aux = B(i)           'la variable auxiliar captura el valor último, el i-ésimo  
   r = Int(RND() * i) + 1     'r es un aleatorio entero entre 1 e i  
   B(i) = B(r)          'el valor i-ésimo será el que tenía A(r,1) que es previo  
   B(r) = aux           'para finalizar la permuta, el valor A(r,1) toma el valor que teníamos guardado en la variable auxiliar  
 Next i  
 For i = 1 To num_extraidos  
   Cells(i + 6, 6) = B(i)  
   Cells(i + 6, 7) = A(B(i), 1)  
 Next i  
 Range("E4").Interior.ColorIndex = 36  
 End Sub  

lunes, 9 de marzo de 2020

Lanzar una macro al producirse un evento de tipo Change

Puede descargar el archivo target.xlsm

Hoja 1


Vamos a crear el rango de color amarillo donde al escribir algo se lance automáticamente una macro que nos saluda. Esto se consigue con la programación por eventos que tiene Excel.


Primero programamos la macro 'saluda' en un módulo de nuestro editor de Visual Basic (VBA).


 Sub saluda()  
 MsgBox ("Hola, ¿qué tal?")  
 End Sub  

Luego nos vamos a la zona de programación para la Hoja1 que es en la que nos encontramos y creamos un evento de tipo Change. Es el siguiente.


 Private Sub Worksheet_Change(ByVal Target As Range)  
 Dim R As Range  
 Set R = Range("$B$6:$B$8")  
 If Intersect(Target, R) Is Nothing Then  
  Application.EnableEvents = False  
  Target.Value = UCase(Target.Value)  
  Application.EnableEvents = True  
  Target.Font.ColorIndex = 5  
 Else  
  If Target.Value > 1000 Then  
   Target.Font.ColorIndex = 3  
  Else  
   Target.Font.ColorIndex = 0  
  End If  
  saluda  
 End If  
 End Sub  



Hoja 2

Otro método para poder actuar sobre un rango concreto consiste en definir el rango indicando las columnas y filas en las que se encuentra.


 Private Sub Worksheet_Change(ByVal Target As Range)  
 If Target.Column = 2 And Target.Row >= 5 And Target.Row <= 8 Then  
  [E5] = Application.WorksheetFunction.Sum(Range("B5:B8"))  
 End If  
 End Sub