Mostrando entradas con la etiqueta VBA. Mostrar todas las entradas
Mostrando entradas con la etiqueta VBA. Mostrar todas las entradas

jueves, 21 de enero de 2021

Criba de Eratóstenes para obtener números primos en Excel

Puede descargar el archivo con el código VBA: eratostenes.xlsm

La criba de Eratóstenes es un método algorítmico que nos permite obtener los números primos inferiores a un valor dado eliminando sucesivamente todos los múltiplos anteriores.

En nuestro ejemplo vamos a obtener los números primos anteriores a 200, que son:

2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197, 199.


 Option Explicit  
 Sub cribado()  
 Dim A(200) As Integer  
 Dim i As Integer, j As Integer  
 Dim color  
 Range("B4:K23").Interior.Pattern = xlNone  
 For i = 2 To 200  
   A(i) = i  
 Next i  
 For i = 2 To 200  
   If A(i) <> 0 Then  
     color = RGB(Rnd * 256, Rnd * 256, Rnd * 256)  
     For j = i + 1 To 200  
       If j Mod i = 0 Then  
         Call colorines(A(j), color)  
         A(j) = 0  
       End If  
     Next j  
   End If  
 Next i  
 End Sub  
 Sub colorines(n, color)  
 Dim fila As Integer, columna As Integer  
 For fila = 4 To 23  
   For columna = 2 To 11  
     If Cells(fila, columna).Value = n And n <> 0 Then  
       Cells(fila, columna).Interior.color = color  
     End If  
   Next columna  
 Next fila  
 End Sub  



Se van coloreando los múltiplos de los diferentes primos que nos encontramos. Finalmente, los números que quedan sin colorear son los números primos.

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  

lunes, 23 de julio de 2018

Variable lógica de control

Puede descargar el archivo booleanoPorDefecto.xlsm


Generamos siete números aleatorios entre 1 y 10 en las celdas del rango B4:H4. En la celda amarilla (B6) generamos otro número en el mismo rango y deseamos conocer si este valor se encuentra entre los siete números generados de la fila 4.

Veamos varias formas de abordar el caso práctico con macros de VBA para Excel.

Caso 1

El primer caso  imprime en la celda C6 la frase 'Se ha encontrado' cuando el valor de la celda B6 coincide con alguno de los siete números de la fila 4. En la fila 4 pueden darse valores repetidos como se puede ver en la imagen siguiente.



El inconveniente de este método reside en que cuando la celda amarilla no coincide con ninguno de los números de la fila 4, en la celda C6 no se imprime nada, ya que no se entra dentro del condicional if en ningún momento. Nos gustaría que si no encuentra coincidencia pusiera una frase indicando que así ha sido. Pero no podemos incluir en el condicional if un else ya que al analizar los siete números cada vez que uno de ellos no coincida con la celda amarilla escribiría la frase indicando que no coinciden. Esto supondría un funcionamiento incorrecto del código. Veamos el segundo caso donde esto se soluciona con la ayuda de una variable booleana.

Sub rastrea()
For i = 1 To 7
  Cells(4, i + 1) = Int(Rnd() * 10) + 1
Next i
n = WorksheetFunction.RandBetween(1, 10)
Range("B6") = n
Range("C6").ClearContents
For i = 1 To 7
  If Cells(4, i + 1) = n Then
    Range("C6") = "Se ha encontrado"
  End If
Next i
End Sub


Caso 2

El código de este caso parte del anterior si bien añade una variable lógica denominada distintos que se inicializa como True. Esto supone que de entrada supondremos que los valores son distintos. Por tanto, supondremos inicialmente que no existe coincidencia de valor entre la celda amarilla y las siete previas de la fila cuatro. Nos metemos en un bucle for que recorre las siete posiciones comprobando con un condicional if si existe coincidencia. Si se detecta alguna coincidencia la variable lógica distintos se torna en False. Finalmente, fuera del bucle, añadimos un nuevo condicional if que analizará si la variable booleana distintos es verdadera y en caso afirmativo imprimirá en la celda B6 la frase 'NO se ha encontrado'.
Observe que en el último condicional if no es necesario poner como condición distintos=True, ya que la variable lógica ya es en si misma True o False.




Sub analiza()
Dim distintos As Boolean
distintos = True
For i = 1 To 7
  Cells(4, i + 1) = Int(Rnd() * 10) + 1
Next i
n = WorksheetFunction.RandBetween(1, 10)
Range("B6") = n
Range("C6").ClearContents
For i = 1 To 7
  If Cells(4, i + 1) = n Then
    distintos = False
    Range("C6") = "Se ha encontrado"
  End If
Next i
If distintos Then
  Range("C6") = "NO se ha encontrado"
End If
End Sub

Caso 3

Este caso es una variante del anterior donde no usamos variable lógica. Lo que hacemos es escribir en la celda C6 de entrada, y como valor por defecto, la frase  'NO se ha encontrado'. Luego, si al analizar la coincidencia de valores se verifica que existe alguna coincidencia lo que se hace es reescribir esa celda con la frase 'Se ha encontrado'. Con este método lo que conseguimos es que si no se encuentra coincidencia de valores la frase inicialmente escrita es válida y se muestra en pantalla sin necesidad de añadirla porque ya existía desde un principio.

Sub noEncontradoPorDefecto()
For i = 1 To 7
  Cells(4, i + 1) = Int(Rnd() * 10) + 1
Next i
n = WorksheetFunction.RandBetween(1, 10)
Range("B6") = n
Range("C6") = "NO se ha encontrado"
For i = 1 To 7
  If Cells(4, i + 1) = n Then
    Range("C6") = "Se ha encontrado"
  End If
Next i
End Sub

Pasar argumentos por valor (ByVal) o por referencia (byRef) en VBA para Excel

Puede descargar el archivo ReferenciaValor.xlsm

En el lenguaje de programación VBA para Excel podemos elegir entre pasar parámetros o argumentos a las funciones o subprocedimientos por valor (ByVal) o por referencia (ByRef). Veremos las diferencias de ambos métodos y pondremos varios ejemplos.


  • ByVal. Cuando se pasa un parámetro por valor lo que se hace es enviar un número si la variable es numérica o un string si la variable es una cadena, o del tipo que sea. No son la misma variable la interna al subprocedimiento o función que la del procedimiento principal, por lo que al terminar el subprocedimiento y retornar el flujo del programa al procedimiento principal la variable no retorna con el valor con el que hubiera acabado el subprocedimiento. Al retornar al procedimiento principal la variable continúa valiendo lo mismo que valía cuando se envió como parámetro. Por ejemplo, si la variable i se envía como parámetro con el valor 5, y al terminar el subprocedimiento o función finaliza con el valor 10, al retornar al procedimiento principal la variable i continuará con el valor 5.
  • ByRef. Cuando se pasa un parámetro por referencia lo que hacemos es enviar una variable con un cierto valor, el que tenga en el momento del envío. Al retornar al procedimiento principal la variable viene con el valor con el que hubiera terminado en el subprocedimiento o función. Por ejemplo, si la variable i se envía como parámetro con el valor 5, y al terminar el subprocedimiento o función finaliza con el valor 10, al retornar al procedimiento principal la variable i vendrá con el valor 10.

Por defecto los parámetros en VBA se pasan ByRef



Caso 1

Disponemos de un procedimiento principal que contiene un bucle for que se repite cuatro veces. Dentro del bucle únicamente tenemos una línea de código que llama al subprocedimiento Saluda y le pasa el valor de i como parámetro.
El subprocedimiento Saluda recoge el parámetro i como valor (ByVal). Mediante un MsgBox mostrará en una pequeña ventana emergente un saludo diciendo Hola junto al valor de i, que será un número de 1 al 4. Luego, y dentro del subprocedimiento, se asigna a i el valor 100.

  • ByVal. Si pasamos el valor de i por valor, al lanzar el procedimiento principal la macro nos saludará cuatro veces y al final ejecutará la última línea del procedimiento principal y nos dirá que i es igual a 5.
  • ByRef. Si pasamos el valor de i por referencia, al lanzar el procedimiento principal únicamente nos saludará una vez diciendo Hola1, pero no seguirá con los siguientes ciclos del bucle for ya que la variable i vuelve con el valor 100. Como 100 es superior al límite dado en el bucle for que es cuatro, se considera que el bucle ha finalizado y por tanto se ejecutará la última línea del procedimiento principal que hace que se muestre en pantalla el valor 101.
 


Sub Principal_1()
For i = 1 To 4
  Call Saluda(i)
Next i
MsgBox (i)
End Sub
Sub Saluda(ByVal i)
  MsgBox ("Hola" & i)
  i = 100
End Sub



Caso 2

En el procedimiento principal asignamos a las variables x, y, z el valor 5. Imprimiremos su valor empleando para la variable x la columna A, para la variable y la columna B y para la variable z la columna C. Llamamos al subprocedimiento Dobla y le pasamos como parámetros los valores x, y, z.
El subprocedimiento Dobla recibe el parámetro x por referencia (ByRef), el parámetro y por valor (ByVal) y el parámetro z lo recibe sin indicar nada para ver cómo trata VBA por defecto los parámetros que se pasan a un subprocedimiento o función. Se dobla el valor de x, y, z. Se imprime nuevamente el valor de x, y, z en la fila dos de las columnas A, B, C respectivamente. Veremos que los valores impresos son 10, 10, 10, esto es así ya que estamos imprimiendo el valor de la variable interna del subprocedimiento y en los tres casos esta variable es el doble de cinco.
Finalizado el subprocedimiento se vuelve al procedimiento principal y en la fila tres se imprimen nuevamente los valores de x, y, z. Pero ahora vemos que lo que se imprime es 10, 5, 10. Veamos el motivo de esta diferencia.


  • ByRef. El parámetro x se pasó por referencia. Continúa siendo la misma variable la que se definió inicialmente en el procedimiento principal, la que luego se usa en el subprocedimiento y la que finalmente retorna al procedimiento principal. Al retornar, vuelve con el valor 10.
  • ByVal. El parámetro y se pasó por valor y por tanto lo que se hace es pasarlo como si fuera un número sin que quede vinculación con la variable inicialmente definida en el procedimiento principal. En el subprocedimiento se dobla el valor y para de 5 a 10, pero al retornar al procedimiento principal no se retorna ningún valor, y la variable y en el procedimiento principal sigue valiendo 5 que es tal y como se definió en un principio.
  • Por defecto. El parámetro z se pasó sin indicar nada y al final se ha comportado como la variable x. Esto indica que si no ponemos nada, por defecto VBA pasa los parámetros por referencia (ByRef).


Sub Principal_2()
x = 5: y = 5: z = 5
Cells(1, "A") = x: Cells(1, "B") = y: Cells(1, "C") = z
Call Dobla(x, y, z)
Cells(3, "A") = x: Cells(3, "B") = y: Cells(3, "C") = z
End Sub
Sub Dobla(ByRef x, ByVal y, z)
x = 2 * x: y = 2 * y: z = 2 * z
Cells(2, "A") = x: Cells(2, "B") = y:: Cells(2, "C") = z
End Sub



Caso 3

Queremos listar los números del 10 al 20. Disponemos de un procedimiento principal que llama a un subprocedimiento que se denomina Listado, al que se pasan dos parámetros a y b. El parámetro b se puede pasar por valor o por referencia. Si se pasa por valor la lista impresa se genera en vertical y si se pasa por referencia la lista impresa se muestra en diagonal.

En el procedimiento principal inicializamos la variable
b haciendo que su valor se igual a uno. Nos metemos en un bucle for donde la variable a varía entre 10 y 20. Dentro del bucle se llama al subprocedimiento Listado pasándole los parámetros a y b.

El subprocedimiento Listado escribe el valor de a en la fila a y columna b. Finalmente tiene una línea de código que incrementa el valor de b en una unidad.

  • ByRef. Si pasamos el parámetro b por referencia el incremento de la variable b en una unidad que se hace en la última línea de código se recordará en el procedimiento principal y por tanto la variable b en el primer ciclo del bucle for valdrá 1, pero en el segundo ciclo ya valdrá 2, en el tercero 3, y así sucesivamente. Esto hace que al ejecutar reiteradamente el subprocedimiento y escribir con cells cada vez se haga en una fila más a la derecha, lo que provoca que el resultado se vea en diagonal.
  • ByVal. Si pasamos el parámetro b por valor la última línea de código que hace que b se incremente en una unidad no se recordará al llegar la procedimiento principal y por tanto b continuará valiendo 1 que es el valor con el que se inicializó. Esto provoca que al ser b siempre igual a uno, no nos movamos de la columna uno, y por tanto la serie de números se imprima en vertical todos ellos en la columna uno.





Sub Principal_3()
b = 1
For a = 10 To 20
  Call Listado(a, b)
Next a
End Sub
Sub Listado(a, ByRef b)
Cells(a, b) = a
b = b + 1
End Sub



Caso 4

Vamos a calcular el montante final al que se llega aplicando la ley de capitalización compuesta con los siguientes datos.
Capital inicial C = 1.000 €
tipo de interés i = 0,15
tiempo años t = 3

Disponemos de un procedimiento principal que llama dos veces a la función Montante. En la función existe una última línea de código que hace que el valor del tipo de interés i se reduzca en un 5%.

  • ByRef. Si pasamos el parámetro i por referencia la primera vez el tipo de interés valdrá 15% y la segunda vez valdrá 10% ya que se ha reducido el valor del tipo de interés y el procedimiento principal toma ese valor ya que no olvida el último valor con el que quedó la variable. Esto provoca que los dos montantes sean diferentes, el primero calculado al 15% y el segundo al 10%.
  • ByVal. Si pasamos el parámetro i por valor la última línea del subprocedimiento no se recordará al llegar al procedimiento principal y por tanto el valor del tipo de interés no se reducirá y continuará siendo del 15%. Esto provoca que los dos montantes sean iguales, ambos calculados al 10%.




Sub Principal_4()
i = 0.15
t = 3
C = 1000
Cells(1, "H") = Montante(i, t, C)
Cells(2, "H") = Montante(i, t, C)
End Sub
Function Montante(ByVal i, t, C)
Montante = C * (1 + i) ^ t
i = i - 0.05
End Function

martes, 17 de julio de 2018

Bucles For anidados

Puede descargar el archivo BuclesForAnidados.xlsm

Vamos a trabajar con dos bucles For...Next anidados. Realizaremos unos ejercicios con macros Excel programando en VBA.

Llegaremos a realizar la siguiente figura con números que van entre 1 y 9, tanto en horizontal como en vertical.


Pero antes de llegar a obtener esa imagen que hemos denominado 'Bandera Color' vamos a ir paso a paso.



Borra

Como vamos a trabajar en varios casos, antes de comenzar  nos interesa borrar el contenido del rango A1.I9. También vamos a borrar el color de fondo de las celdas.


Sub Borra()
Dim R As Range
Set R = Range("A1:I9")
R.ClearContents
R.Interior.Pattern = xlNone
End Sub


Completo

Anidamos dos bucles For para conseguir imprimir en cada una de las celdas del cuadrado de 9 filas y 9 columnas, los números i j.



Sub Completo()
Dim i As Byte, j As Byte
Call Borra
For i = 1 To 9
  For j = 1 To 9
    Cells(i, j) = Str(i) & " " & Str(j)
  Next j
Next i
End Sub


Caja

Ahora queremos que no se imprima el cuadrado completo, únicamente deseamos imprimir los bordes. Para ello precisamos incluir dentro de los bucles anidados un condicional if que imprima únicamente los índices i j cuando se cumpla que el primero es igual a 1 o 9, o bien el segundo sea igual a 1 o 9. De esta forma conseguimos imprimir solo el perímetro del cuadrado.



Sub Caja()
Dim i As Byte, j As Byte
Call Borra
For i = 1 To 9
  For j = 1 To 9
    If i = 1 Or i = 9 Or j = 1 Or j = 9 Then
      Cells(i, j) = Str(i) & " " & Str(j)
    End If
  Next j
Next i
End Sub


Diagonal 1

Queremos imprimir únicamente la diagonal primera que se consigue haciendo que el condicional if filtre únicamente aquellos valores donde los índices i j coincidan.




Sub Diagonal_1()
Dim i As Byte, j As Byte
Call Borra
For i = 1 To 9
  For j = 1 To 9
    If i = j Then
      Cells(i, j) = Str(i) & " " & Str(j)
    End If
  Next j
Next i
End Sub


Diagonal 2

La segunda diagonal se consigue buscando qué tienen en común los índices i j. Observamos que esta diagonal cumple que al sumar ambos índices la suma siempre es igual a 10. Esta será la condición que impondremos en el condicional if.



Sub Diagonal_2()
Dim i As Byte, j As Byte
Call Borra
For i = 1 To 9
  For j = 1 To 9
    If i + j = 10 Then
      Cells(i, j) = Str(i) & " " & Str(j)
    End If
  Next j
Next i
End Sub


Bandera


Deseamos imprimir únicamente los bordes y las dos diagonales. A esta figura la hemos llamado bandera. Observe que se consigue incluyendo en el if seis condiciones concatenadas con el operador lógico Or.



Sub Bandera()
Dim i As Byte, j As Byte
Call Borra
For i = 1 To 9
  For j = 1 To 9
    If i = 1 Or i = 9 Or j = 1 Or j = 9 Or i = j Or i + j = 10 Then
      Cells(i, j) = Str(i) & " " & Str(j)
    End If
  Next j
Next i
End Sub


Bandera Color

Nos gustaría que la bandera tuviera colores. Los colores de fondo de cada celda se consiguen con Interior.ColorIndex=número. Donde el número nos da el color.





Sub BanderaColor()
Dim i As Byte, j As Byte
Call Borra
For i = 1 To 9
  For j = 1 To 9
    If i = j Or i + j = 10 Then
      Cells(i, j) = Str(i) & " " & Str(j)
      Cells(i, j).Interior.ColorIndex = 3 'rojo
    ElseIf i = 1 Or i = 9 Or j = 1 Or j = 9 Then
      Cells(i, j) = Str(i) & " " & Str(j)
      Cells(i, j).Interior.ColorIndex = 6 'amarillo
    Else
      Cells(i, j).Interior.ColorIndex = 8 'azul
    End If
  Next j
Next i
End Sub

Ya tenemos bandera.

lunes, 4 de junio de 2018

Triángulo de Floyd

Puede descargar el archivo trianguloFloyd.xlsm

El triángulo de Floyd para cuatro filas es el siguiente.


Se construye con los números naturales en forma de triángulo rectángulo. Se suele utilizar como ejercicio para los que están aprendiendo a programar en un cierto lenguaje.

El triángulo de Floyd se resuelve con un algoritmo que ideó el Dr. Floyd, científico e informático que fue compañero de habitación de Carl Sagan cuando ambos estudiaban en la universidad.

Hoja 1

Resuelto usando fórmulas de Excel y sin usar macros.



La fórmula de la celda C5 calcula el máximo de la fila anterior para saber con qué número se ha de comenzar la fila actual.

=MAX(C4:P4)+1

La celda D5 suma 1 al valor previo y usa un condicional SI para saber hasta que valor se ha de continuar sumando 1.

=SI(CONTAR($C5:C5)<$A5;C5+1;"")

Hoja 2

También resuelve el triángulo con fórmulas y sin usar macros.

En este caso las celdas de la primera columna se obtienen con una fórmula que indica que nos da el último valor de la fila precedente y le suma 1. Se cumple que los últimos valores de cada fila son los llamados números triangulares, que se obtienen como n*(n+1)/2. Siendo n el número de fila.


En nuestro caso la celda C5 tiene la siguiente expresión.

=(A5*(A5-1)/2)+1

La celda D5 se calcula con la siguiente fórmula, que es igual a la empleada en la Hoja1.

=SI(CONTAR($C5:C5)<$A5;C5+1;"")

Hoja3

Se construye el triángulo de Floyd mediante macro.


Sub Floyd1()
Dim n As Long, i As Long, j As Long, n_max As Long
Dim R As Range
Worksheets("Hoja3").Activate
Set R = Range("B3")
n_max = 24: j = 1
R.Offset(1, -1).Resize(n_max+2, n_max+2).ClearContents
For n = 1 To n_max
  R.Offset(n, -1) = n 'imprimimos la columna A
  For i = 1 To n 'i recorre los elementos de cada fila
    R.Offset(n, i) = j 'imprimimos el valor de j en la celda que toca
    j = j + 1  'j proporciona los números naturales correlativos
  Next i
Next n
End Sub


Hoja4

Dada una fila n, podemos calcular el último valor de su fila usando los números triangulares que son los siguientes.


  1. Para n=1 el número triangular es 1
  2. Para n=2 el número triangular es 3
  3. Para n=3 el número triangular es 6
  4. Para n=4 el número triangular es 10
  5. Para n=5 el número triangular es 15

A esos valores e le suma 1 para saber cuál es el primer valor de la fila siguiente.

Sub Floyd2()
Dim n As Long, i As Long, j As Long, n_max As Long
Dim R As Range
Worksheets("Hoja4").Activate
Set R = Range("B3")
n_max = 24
R.Offset(1, -1).Resize(n_max+2, n_max+2).ClearContents
For n = 1 To n_max
  R.Offset(n, -1) = n
  'primera columan del triángulo
  R.Offset(n, 1) = (n * (n - 1) / 2) + 1
  For i = 2 To n
    R.Offset(n, i) = R.Offset(n, i - 1) + 1
  Next i
Next n
End Sub

Hoja5


Una pequeña variante para poder elegir el número de filas desde un control numérico que se encuentra en la propia hoja de cálculo.


También está disponible en un lenguaje de programación que está muy de moda.

domingo, 3 de junio de 2018

Seleccionar tabla sin cabecera

Puede descargar el archivo seleccionaTabla.xlsm

Primero generamos una tabla con valores aleatorios y con un número de filas que podemos elegir, con un control numérico, entre 1 y 20.


La macro que genera la tabla con valores aleatorios es la siguiente.

Observe que se define la celda B4 como la esquina superior izquierda y en base a ella se genera toda la tabla. Esta esquina sería fácil de variar en el código de la macro, gracias al uso de Offset.

Sub generaTabla()
Dim n As Byte, i As Byte
Dim R As Range
Set R = Range("B4")
n = [I2]
Range("B5:F24").ClearContents
For i = 1 To n
  R.Offset(i, 0) = i
  R.Offset(i, 1).Value = WorksheetFunction.Choose(Int(Rnd() * 3) + 1, "Norte", "Sur", "Centro")
  R.Offset(i, 2).Value = Date - i + 1
  R.Offset(i, 3).Value = WorksheetFunction.Choose(Int(Rnd() * 3) + 1, "Libros", "Comic", "Web")
  R.Offset(i, 4).Value = (Int(Rnd() * 100000) + 20000) / 100
Next i
End Sub


El código VBA que selecciona la tabla sin incluir la cabecera es la siguiente.

Sub seleccionaTablaSinCabecera()
Worksheets("Hoja1").Activate
'el cursor inicialmente tiene que estar dentro de la tabla
Range("B5").Select
Set R = ActiveCell.CurrentRegion
R.Offset(1, 0).Resize(R.Rows.Count - 1, R.Columns.Count).Select
End Sub

Aquí vemos otro uso estupendo de Offset combinado con Resize, propiedad de los rangos que hemos visto recientemente. Puede verlo en el post siguiente.

viernes, 1 de junio de 2018

Árbol binomial generado con una macro

Puede descargar el archivo arbolBinomial.xlsm

Vamos a crear un árbol binomial usando una macro de Excel, con un poco de código VBA. Lo interesante del caso es que al variar el número de periodos n el árbol se recalcula y se redimensiona en tamaño.

Partimos de un precio de una acción de S=100 €. Este precio puede subir o bajar en cada periodo. Suponemos que si sube lo hará con incrementos del 25% (u=1,25) y si baja lo hace con disminución del 20% (d=0,80).

Se cumple que d=1/u

1 / 1,25 = 0,80

n=1


El árbol para un periodo sería el siguiente.


Donde
125 = 100 * 1,25
80 = 100 * 0,80

Partiendo del precio inicial de 100, transcurrido un periodo pueden suceder dos cosas, o bien, el precio se incrementa y 25% pasando a ser 125 €, o bien se reduce un 20% pasando a ser 80 €.

n=2

Si hacemos el árbol para dos periodos.


Donde
156,25 = 125 * 1,25
100 = 125 * 0,80  o bien  100 = 80 * 1,25
64 = 80 * 0,80

Para el periodo 2, el valor mayor  (156,25) se obtiene incrementando un 25% más el precio superior del periodo anterior. También se puede ver como que 156.25 = 100 * 1,25 * 1,25, ya que se parte de un precio inicial de 100 y se experimentan dos incrementos del 25%.

El valor de 100 € del periodo 2 se alcanza por uno de los dos siguientes caminos.
  • 100 = 100*1,25*0,80 Partimos de 100, subimos a 125 y luego volvemos a bajar a 100.
  • 100 = 100 *0.80*1,25. Partimos de 100, bajamos a 80 y luego volvemos a subir a 100.
El valor de 64 se puede entender que se alcanza partiendo del precio inicial de 100 y experimentando dos reducciones consecutivas del 20%. 64 = 100 * 0,80 * 0,80

n=3

Si hacemos el árbol para tres periodos.


Donde
195,3125 = 100 * 1,253
125 = 100 * 1,252 * 0,80
80 =  100 * 1,25 * 0,802
51,2 = 100 * 0,803

Para n>3

La macro funciona hasta n=40, y no por la limitación de la propia macro sino porque hemos limitado hasta 40 el valor que se puede poner en la celda amarilla (C7) usando el control numérico que está a su lado.



Option Explicit
Public n As Integer 'número de etapas del árbol, hasta 40
Public A() As Double 'matriz que contiene el árbol

Sub arbol()
Dim i As Integer, j As Integer
Dim u As Double, d As Double
Worksheets("Hoja1").Activate
n = [C7]: u = [C4]: d = [C5]
Call borra
Call cabeceras
ReDim A(2 * n, n) 'el árbol tiene el doble de filas que de columnas
A(n, 0) = 100 'valor inicial en la columna cero
For j = 1 To n  'columnas de la matriz
  For i = 0 To 2 * n 'filas
    If j = n - i Then 'primero calculamos la diagonal superior
      A(n - j, j) = A(n - j + 1, j - 1) * u
    ElseIf j >= n - i + 2 And j <= i + n Then 'calculamos el resto
      A(i, j) = A(i - 1, j - 1) * d
    End If
  Next i
Next j
Call imprimeA
End Sub
Sub borra()
Range("C10:AR91").Clear ' borra hasta n=40
End Sub
Sub cabeceras()
Dim i As Integer
Range("A1").Copy ' copiamos A1 para luego pegar el formato
'pegamos el formato de A1 a la columna C
Range(Cells(10, "C"), Cells(2 * n + 11, "C")).PasteSpecial Paste:=xlPasteFormats
'pegamos el formato de A1 a la fila 10
Range(Cells(10, 4), Cells(10, n + 4)).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False 'elimina la fila de hormigas
For i = 0 To n
  'generamos los números 0 a 2n de la columna C
  Cells(i + 11, 3) = i 'vertical, los n primeros
  Cells(i + n + 11, 3) = i + n 'vertical, los n últimos
  'generamos los números 0 a n de la fila 10
  Cells(10, i + 4) = i 'horizontal
Next i
Range("C10").Activate 'situamos el cursor en C10
End Sub
Sub imprimeA()
Dim i As Integer, j As Integer
For j = 0 To n
  For i = 0 To 2 * n 'recorremos toda la matriz A
    If A(i, j) <> 0 Then 'imprimimos solo los no vacios
      Cells(i + 11, j + 4) = A(i, j)
    End If
  Next i
Next j
End Sub

La idea básica para hacer el árbol es que la diagonal superior se obtiene como el precio anterior por u. Y el resto de los valores del árbol se obtienen como el precio superior del periodo anterior por d.

Ejemplo para n=4.


244,1 se obtiene como 195,3 * 1,25
El resto de valores se obtienen multiplicando por 0,80, así tenemos los siguientes.
156,3 = 195,6 * 0,80
100 = 125 * 0,80
64 = 80 * 0,80
40,96 = 51,2  * 0,80

Este es el método que usa la macro para obtener todos los valores del árbol binomial.

Lo que más esfuerzo ha costado es calcular bien las celdas donde se han de escribir los valores del árbol ya que al crecer n el árbol va aumentando de tamaño y es necesario ir bajando la celda inicial.

jueves, 31 de mayo de 2018

Manejar matrices con VBA

Puede descargar el archivo manejarMatrices.xlsm

Vamos a trabajar con matrices en Excel programando en VBA (Visual Basic for Applications).


Lo interesante de este caso es ver que para dejar el contenido de una matriz en la hoja de cálculo lo que debemos hacer es lo que nos dice la intuición.

Rango = Matriz 'respetando las dimensiones


Option Base 1 'Las matrices empiecen en 1 y no en 0

Sub manejaMatriz()
Dim A As Variant
Dim B As Variant
'para asignar un rango a una matriz
A = Range("B4:E9")
'para asignar una matriz a un rango
B = WorksheetFunction.Transpose(A)
'para imprimir una matriz en un rango
Range("B11:G14") = B
End Sub

Sub aleatorios()
Dim A(6, 4) As Double
Dim inicio As Range
Dim final As Range
Randomize 'para mejorar la aleatoriedad
For i = 1 To 6
  For j = 1 To 4
    'números aleatorios [0,1) a dos decimales
    A(i, j) = Int(Rnd() * 100) / 100
  Next j
Next i
Set inicio = Cells(4, "B")
Set final = Cells(9, "E")
Range(inicio, final) = A
End Sub

Sub multiplicaMatriz()
Dim A() As Variant
Dim B() As Variant
Dim C() As Variant
A = Range("B4:E9")
B = Range("B11:G14")
C = WorksheetFunction.MMult(A, B)
Range("B16:G21") = C
End Sub

Sub invierteMatriz()
Dim A() As Variant
A = Range("B23:D25")
Range("B27:D29") = WorksheetFunction.MInverse(A)
Range("B27:D29").Interior.Color = 6750156
Call extraeElementos
End Sub

Sub extraeElementos()
Dim A() As Variant
Dim origen As Range
Range("M4:AC30").Clear
Range("M4:AC30").Interior.Color = 13434879 'amarillo
Set origen = Range("L3")
A = Range("B27:D29")
fila = [L14]
columna = [S2]
For i = 1 To 3 'recorremos las 3 filas de la matriz
  For j = 1 To 3 'recorremos las 3 columnas de A
    With origen.Offset(fila + i - 1, columna + j - 1)
    .Value = A(i, j)
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    End With
  Next j
Next i
Range(origen.Offset(fila + i - 4, columna + j - 4), origen.Offset(fila + i - 2, columna + j - 2)).Interior.Color = 6750156
End Sub

Sub copia()
Dim A As Variant
A = Range("B4:D6")
Range("B23:D25") = A
Range("B4:D6,B23:D25").Interior.ColorIndex = 8
End Sub

Sub Borra()
Range("B4:AD32").ClearContents
[S2] = 1: [L14] = 1
Range("B4:G29").Interior.Pattern = xlNone
Range("M4:AC30").Clear
Range("M4:AC30").Interior.Color = 13434879 'amarillo
End Sub

También es interesante ver el pos siguiente.

Propiedad Resize para manejar rangos en Excel

Puede descargar el archivo resize.xlsm

Cuando programamos macros en Excel usando VBA es muy habitual trabajar con rangos. Una propiedad de los rangos que modifica su tamaño es resize.

Rango.Resize(filas, columnas).Select

Veamos algunos ejemplos de su uso.



Resize1

Da color aleatorio a las celdas del rango B4:E8.

Sub Resize1()
Dim rojo As Byte, verde As Byte, azul As Byte
Dim R As Range
Set R = Range("B4")
Range("A1").Select
Randomize 'elegimos colores aleatorios
rojo = Int(Rnd() * 100) + 100
verde = Int(Rnd() * 100) + 100
azul = Int(Rnd() * 100) + 100
R.Resize(5, 4).Interior.Color = RGB(rojo, verde, azul)
End Sub

Observe que después de Resize(5.4) se ha de poner algo, o bien, .Select para seleccionar, o bien, .Interior.Color=RGB(rojo, verde, azul) como en este caso. Pero si después de Resize se deja sin poner nada nos dará error.

Resize2

Permite seleccionar un rango de 3 filas y 2 columnas usando como celda de origen la B4.

Range("B4").Resize(3, 2).Select



Sub Resize2()
'Seleccionamos un rango de 3 filas y 2 columnas
'La celda de origen es B4
Range("B4").Resize(3, 2).Select
End Sub

Resize3

Permite seleccionar un rango de 3 filas en la primera columna usando como celda de origen la B4.

Range("B4").Resize(3).Select



Sub Resize3()
'Seleccionamos un rango de 3 filas de la primera columna
'La celda de origen es B4
Range("B4").Resize(3).Select
End Sub

Resize4

Permite seleccionar un rango de 3 columnas en la primera fila usando como celda de origen la B4.

Range("B4").Resize(, 3).Select




Sub Resize4()
'Seleccionaremos un rango de 3 columnas de la primera fila
'La celda de origen es B4
Range("B4").Resize(, 3).Select
End Sub

Resize5

Permite seleccionar un rango de 2 columnas en la primera fila usando como celda de origen la B4 y hasta la fila 8, ya que el rango indicado es hasta la E8.

Range("B4:E8").Resize(, 2).Select



Sub Resize5()
Range("B4:E8").Resize(, 2).Select
End Sub

Resize6

Permite seleccionar un rango de 3 columnas en la primera fila usando como celda de origen la A4.

Range("B4").Offset(, -1).Resize(, 3).Select

Es una maravilla poder usar Offset para cambiar el rango de referencia, y usar, como en el ejemplo, valores negativos. Esto aporta flexibilidad al manejar gran cantidad de rangos cambiantes.


Sub Resize6()
Range("B4").Offset(, -1).Resize(, 3).Select
End Sub

Resize7

Copia el rango amarillo (B11:E15) en el rango superior (B4:E8).

Range("B4").Resize(5, 4) = A

Este es un uso muy útil de la propiedad Resize ya que nos permite depositar (imprimir) de golpe todo un rango o el contenido de una matriz.



Sub Resize7()
Dim A As Variant
Worksheets("Hoja1").Range("A1").Select
A = Range("B11:E15")
Range("B4").Resize(5, 4) = A
End Sub

Resize8

Hace lo mismo que la macro anterior, copia el rango amarillo (B11:E15) en el rango superior (B4:E8).

Range("B4").Resize(R.Rows.Count, R.Columns.Count) = A

Este procedimiento realiza el mismo trabajo que el anterior aunque lo hemos programado de otra forma. En este caso, creamos las variables n y m que calculan el número de filas y columnas respectivamente del rango R. De esta forma hacemos más flexible el código ya que evitamos tener que dar nosotros los parámetros a la propiedad Resize.

Sub Resize8()
Dim A As Variant
Dim R As Range
Worksheets("Hoja1").Range("A1").Select
Set R = Range("B11:E15")
A = R
n = R.Rows.Count
m = R.Columns.Count
Range("B4").Resize(n, m) = A
End Sub

Resize9

Genera una matriz de números aleatorios y la imprime en una posición inicial variable y con un tamaño variable.

Range(Cells(pf, pc), Cells(pf, pc)) .Resize(n, m) = A


Seguidamente se muestra el código de ejemplo utilizado para ilustrar la versatilidad de la propiedad Resize.

Sub Resize9()
Dim A As Variant
Dim R As Range
Dim tf As Byte, tc As Byte, pf As Byte, pc As Byte
Worksheets("Hoja2").Activate
Range("E7:AQ45").Clear
Randomize
Range("A1").Select
tf = Int(Rnd() * 20) + 1 'tamaño:fila
tc = Int(Rnd() * 20) + 1 'tamaño: columna
pf = Int(Rnd() * 20) + 7 'posición inicial: fila
pc = Int(Rnd() * 20) + 5 'posición inicial: columna
[C6] = tf
[D6] = tc
[C5] = pf
[D5] = pc
Set R = Range(Cells(pf, pc), Cells(pf + tf - 1, pc + tc - 1))
R.Interior.Color = RGB(0, 255, 100)
A = R
n = R.Rows.Count
m = R.Columns.Count
ReDim A(n, m)
For i = 1 To n
  For j = 1 To m
    A(i, j) = Int(Rnd() * 100)
  Next j
Next i
Range(Cells(pf, pc), Cells(pf, pc)).Resize(n, m) = A
End Sub

Veamos un GIF animado donde se aprecia que el rango varía en posición y tamaño de forma aleatoria.


Conviene ver cómo se resolvió en otros casos la necesidad de imprimir de golpe toda una matriz, incluso de gran tamaño. Recomiendo ver los siguientes enlaces a otros post publicados.