VBA:Uniendo rangos discontinuos con Arrays

Como continuación del post anterior: 'VBA: Trabajando sobre rangos discontinuos', hoy veremos una variante algo más abierta.
Trabajaremos sobre rangos discontinuos mediante arrays en nuestro procedimiento.

Supongamos nuestros tres rangos dscontinuos (igual que en l post anterior):
B2:B6
D2:D6
y F2:F6

Pretendemos recorrer esas celdas... y para ello insertaremos en el siguiente procedimiento en un módulo estándar:

Sub UnirRangosConArrays()
'definimos la matriz con la que cargaremos los rangos
Dim aRng(1 To 3) As Range

'definimos los rangos
Set aRng(1) = Range("B2").CurrentRegion
Set aRng(2) = Range("D2").CurrentRegion
Set aRng(3) = Range("F2").CurrentRegion

'recorremos la matriz cargada, con los distintos rangos discontinuos
For i = LBound(aRng) To UBound(aRng)
    'recorremos cada celda de cada rango
    For Each celda In aRng(i)
        'llevamos datos a la ventana de inmediato
        Debug.Print celda.Address, celda.Value
    Next celda
Next i

End Sub

Se observa lo simple del proceso... nos permite recorrer las diferentes celdas de nuestros rangos...
Si accedes a la venta de inmediato del editor de Vb (presiona Ctrl+g) veremos algo así (para mi ejemplo):
$B$2 10
$B$3 20
$B$4 30
$B$5 40
$B$6 50
$D$2 100
$D$3 200
$D$4 300
$D$5 400
$D$6 500
$F$2 1000
$F$3 2000
$F$4 3000
$F$5 4000
$F$6 5000

Una alternativa a Application.Union que vimos ;-)

Una importante cualidad de esta forma de trabajar es que nos permite operar sobre rangos discontinuos en diferentes hojas!!.

Seguir leyendo...

VBA: application.Union-Trabajando sobre rangos discontinuos

Veremos un ejemplo hoy de como trabajar sobre rangos discontinuos desde nuestras macros.
Para ello haremos uso de una de las propiedades del objeto Application que vimos en este otro post

Emplearemos la propiedad: Application.Union para resolver esta cuestión.

La idea del ejemplo de hoy e ser capaz de recorrer con n solo bucle un rango de celdas discontinuo..(B2:B6, D2:D6 y F2:F6)

Para ello crearemos nuestro procedimiento en un módulo estándar:

Sub UnionRangosDiscontinuos()
'Unir tres rangos discontinuos
Dim rng1 As Range, rng2 As Range, rng3 As Range
'definimos los tres rango discontinuos a unir
Set rng1 = Range("B2").CurrentRegion
Set rng2 = Range("D2").CurrentRegion
Set rng3 = Range("F2").CurrentRegion

'los unimos con la propiedad .Unión !!!
Dim rngUnido As Range
Set rngUnido = Application.Union(rng1, rng2, rng3)

'demostramos que el recorrido se hace sobre el rango discontinuo
For Each celda In rngUnido
    With celda
        .Font.Bold = True
        .Interior.Color = vbYellow
    End With
Next celda

End Sub

Listo... rápido y simple.
Podemos comprobar, al ejecutar nuestra macro, que el resultado es el esperado...
solo recorremos las celdas de los tres rangos definidos.

Más adelante expondré una alternativa con arrays más eficiente...

Seguir leyendo...

VBA: Saltos en listados no correlativos

Veremos hoy un desarrollo con programación y una alternativa con matriciales para descubrir qué valores faltan entre dos números que indiquemos...
Se trata de dar respuesta a la cuestión planteada por un usuario del blog:

[...]Tengo esta cuestión como puedo encontrar los 'faltantes' del correlativo, no se si puede mostrar en una solo celda o en varias hacia la derecha.[...]

Según esta imagen...

Una primera solución sería la aplicación de algo de programación.... donde crearemos una función personalizada-UDF que a través de unos bucles recupere los elementos 'faltantes' entre dos elementos dados.

Crearemos nuestra función personalizada UDF llamada 'SaltoNumeros' en un módulo estándar:

Function SaltoNumeros(valor1 As Range, valor2 As Range) As String
Dim arrSaltos() As Variant
Dim Faltas As Long
'calculamos el número de valores que falta...
Faltas = valor2 - valor1 - 1

'creamos la matriz de dimensión el nñumero de elementos que faltan
ReDim arrSaltos(1 To Application.Max(1, Faltas)) As Variant

If Faltas = 0 Then
    SaltoNumeros = ""
Else
    'llenamos la matriz con los valores que faltan
    For i = 1 To Faltas
        arrSaltos(i) = valor1 + i
    Next i
    'y terminamos componiendo un concatenado de ellos
    For v = 1 To UBound(arrSaltos)
        SaltoNumeros = SaltoNumeros & ", " & arrSaltos(v)
    Next v
    'quitamos e lúltimo separador
    SaltoNumeros = Mid(SaltoNumeros, 3, Len(SaltoNumeros))
End If
End Function

En el rango 'amarillo' de la imagen, rango C2:C14, hemos insertado nuestra fórmula:
=SaltoNumeros($A2;$A3)
que luego arrastraremos hasta el fin del rango.
Observamos que lo retornado coincide con la necesidad expresada manualmente.
Esta solución se obtiene, en este caso, en la misma celda de manera concatenada.

una alternativa a la programación es el uso matricial de diferentes fórmulas.
En la primera imagen (más arriba) en el rango verde (rango D2:H14) veíamos el resultado.
En este segundo caso, obtendremos cada elemento 'faltante' en una celda diferente... estando sujeto a una posible falta de columnas.

Nuestra fórmula matricial en D2 es:
=SI.ERROR(INDICE($A2+TRANSPONER(FILA(INDIRECTO("1:" & $A3-$A2-1)));1;COLUMNAS($D$1:D$1));"")
(recuerda ejecutarla matricialmente presionando Ctrl+Mayusc+Enter !!)

Luego podemos arrastrar al resto del rango.

La clave es el uso extendido de
FILA(INDIRECTO("1:" & $A3-$A2-1))
para obtener un número correlativo: 1,2,3,...
que sumaremos al valor de inicio de nuestro intervalo (A2 en el ejemplo).
Para poder trabajar por columnas hemos tenido que aplicarle la función TRANSPONER.
Esta suma matricial devuelve una constante matricial, por ejemplo: {104\105\106}

Así pues en el siguiente paso con la función INDICE sobre esa matriz, recuperamos los elementos de la columna 1, 2, 3, etc...
Tal como se muestra en el rango D2:H14.

Resolviendo la cuestión planteada por el usuario...

Seguir leyendo...

SUMAR.SI condicionado sobre diferentes hojas

Daremos una segunda vuelta de tuerca a un tema recurrente que ya hemos visto en ocasiones anteriores en el blog (ver uno y dos).

Trataremos la forma de conseguir sumar de manera condicionada sobre todas las hojas del libro deseadas, siempre que existe una distribución por columnas homogénea en todas las hojas.

El desarrollo que veremos nace por la necesidad de una alumna en uno de los cursos que impartí recientemente, donde a partir de ficheros con un número alto de hojas de trabajo (más de cien en algún caso), debía obtener un consolidado de acuerdo a uno elemento o condición... y lo expuesto en esto otro post) quedaba un poco inoperativo.

Supongamos un fichero con tres hojas (en realidad podrían ser 300...): ene, feb y mar; donde tenemos una serie de códigos repetidos en las columnas A de cada hoja, igualmente cantidades a consolidar 'unidades' e 'importe' en las columnas B y C.
Es fundamental que se de esta circunstancia: Datos dispuestos en mismas columnas!!!

Nuestro objetivo acumular en una primera hoja 'resumen' los valores de unidades e importes que aparezcan en el resto de hojas...

La diferencia respecto al método empleado en el post anterior comentado será el número de hojas involucradas, que podría ser desconocido.
La clave por tanto es identificar y listar los nombres de todas las hojas de libro empleando la función de Excel 4.0: GET.WORKBOOK o en español INDICAR.LIBRO.

OJO!!, esto requerirá que nuestro libro de trabajo se grabe como libro de Excel habilitado para macros!!.

Por otra parte para poder hacer uso de este tipo de funciones en nuestras hojas, deberemos emplearlo dentro de los nombres definidos!!.

El primer paso es generar un nombre definido que comprenderá todas las hojas.
Nuestro nombre definido se llamará 'NombreHojas' y deberemos incluir la siguiente fórmula:
=REEMPLAZAR(INDICAR.LIBRO(1)&T(AHORA());1;ENCONTRAR("]";INDICAR.LIBRO(1)&T(AHORA()));"")

INDICAR.LIBRO devuelve el nombre completo de nuestro libro incluyendo la hoja...
Con la función REEMPLAZAR eliminamos el nombre del libro y nos quedamos únicamente con lo que nos interesa, que es el nombre de la hoja.

Para conseguir el listado de nuestras hojas, aplicaremos la función INDICE sobre el conjunto de nombres que retornará INDICAR.LIBRO.
Para ello crearemos una tabla donde insertaremos un orden desde 2 hasta un número alto, que represente la posición de todas las hojas de nuestro libro (esto es, 2,3,4,5, ..., 300).
Comenzamos en 2 por que la hoja 1 es la de 'resumen', hoja sobre la que no deseamos operar.

En la tabla añadimos la fórmula:
=SI.ERROR(INDICE(NombreHojas;[@orden]);"")

Ya tenemos el listado de hojas del libro que necesitábamos.
Este paso se puede obviar y escribir manualmente si el listado fuera personalizado.

En el siguiente paso generaremos un nuevo nombre definido con fórmula para trabajar sobre las hojas existentes.
El nombre lo llamaré 'MisHojas' y tendrá la fórmula:
=DESREF(TblHojas[[#Encabezados];[hojas]];1;0;CONTARA(TblHojas[hojas])-CONTAR.BLANCO(TblHojas[hojas]))

que devolverá las hojas existentes, evitando las vacías que provocarían fallos en los pasos siguientes.

Y finalmente compondremos nuestra fórmula matricial definitiva para consolidar los datos de las diferentes hojas según el código buscado.

En D4 insertamos y ejecutamos matricialmente (presionando Ctrl+mayusc+Enter):
=SUMA(SUMAR.SI(INDIRECTO(MisHojas & "!A:A");$C4;INDIRECTO(MisHojas & "!B:B")))

y en E2 insertamos y ejecutamos matricialmente (presionando Ctrl+mayusc+Enter):
=SUMA(SUMAR.SI(INDIRECTO(MisHojas & "!A:A");$C4;INDIRECTO(MisHojas & "!C:C")))

arrastrando después tanto como necesitemos...

Consiguiendo nuestra meta...

Seguir leyendo...

VBA: una función para gobernarlas a todas

En el pasado post hablamos de algunos de los métodos del objeto Application...
En el día de hoy aplicaremos uno de ellos .Evaluate, que nos permitirá trabajar con cualquier función de tipo lineal (una variable).
Crearemos de una manera muy sencilla una función para gobernarlas a todas. (Si Mr. Tolkien me permite la licencia...)

En la ventana de código de un módulo estándar incluimos el siguiente procedimiento:

Function FuncionesLineales(fx As String, valor_x As Double) As Double
'aplicamos dos reemplazamientos
'1- para cambiar la variable por el valor concreto asignado
'2- tenemos en cuenta el cambio de configuración de los separadores decimales
'(recuerda que en el entorno del editor de VB el separador decimal es el punto, y no la coma!!)
func = Replace(Replace(fx, "x1", valor_x), ",", ".")

'retornamos el valor a la función creada
FuncionesLineales = Application.Evaluate(func)

End Function

Veamos el uso de nuestra UDF recién creada:

Comprobamos cómo a partir de una función expresada como cadena de texto en una celda, somos capaces de convertirla en una función 100% operativa.
Como se observa en la imagen la misma función creada 'FuncionesLineales' aplicada sobre diferentes celdas/funciones, devuelve los datos correspondientes...
Relevante es llamar a nuestra variable como 'x1' (equis uno) para que el reemplazamiento funcione correctamente...

OJO: la función debe emplear los términos, operadores o nombres de funciones en algo entendible en el entorno de programación.

Seguir leyendo...

VBA: El objeto Application en Excel

Me gustaría repasar uno de los objetos de Excel menos conocidos pero más amplios: el objeto Application.

Sobre este objeto Application podemos trabajar con multitud de eventos, métodos y propiedades.
Son tantos que he optado por mostrar un corta de lista de los más frecuentes.

Comenzaré por algunos de los métodos más interesantes (a mi elección):
1- Application.Calculate: que permite forzar el recálculo del libro completo, una hoja o un rango específico.

'Todos los libros abiertos 
Application.Calculate
'o sencillamente 
Calculate

'Una hoja de cálculo determinada 
Worksheets(1).Calculate

'Un rango específico 
Worksheets(1).Range("A1:E10").Calculate

Otro método:
2- Application.Evaluate: de manera similar a INDIRECTO convierte un nombre o texto que siga la convención de nomenclatura de Excel (la longitud del nombre debe ser menor o igual a 255 caracteres) en un objeto o un valor...

Importante!: El uso de corchetes (por ejemplo, "[A1:D13]") equivale a llamar al método Evaluate con un argumento de cadena. Por ejemplo, son equivalentes:

[A13].Value = 1313
Evaluate("A13").Value = 1313

Vble = [COS(90)]
Vble = Evaluate("COS(90)")

Set celda = Workbooks("Libro1.xlsm").Sheets(1).[A1]
Set celda = Workbooks("Libro1.xlsm").Sheets(1).Evaluate("A1")

Otro método más:
2- Application.Quit: sale y cierra la aplicación Excel (no únicamente los libros de trabajo).
Si hubiera algún libro abierto, Excel mostrará un cuadro de diálogo para preguntarnos si queremos guardar los cambios... igual que si cerráramos manualmente la aplicación.

Application.Quit

Otro método más:
2- Application.Union: para componer rangos a partir de otros ya existentes

Set RangoUnion = Application.Union(Range("A1:A13"), Range("C1:C13"))
RangoUnion.Formula = "Excelforo"

Pasaremos a continuación a recorrer algunas propiedades interesantes.

1- Application.Calculation: que permite modificar la opción de cálculo (Automático, Manual o Automático excepto tablas de datos).

2- Application.CalculateBeforeSave: indicaremos True para que los libros se calculen antes de guardarlos en el disco
OJO:si la propiedad Calculation se establece como xlManual.

3- Application.CalculateBeforeSave: indicamos cuál es la tecla habilitada para interrumpir el recálculo de nuestras fórmulas (xlAnyKey, xlNoKey o xlEscKey).

Application.Calculation = xlCalculationAutomatic
Application.CalculateBeforeSave = True
Application.CalculateBeforeSave = xlEscKey

4- Application.Caption: Devuelve o establece un valor String que representa el nombre que aparece en la barra de título de la ventana principal de Microsoft Excel (es la parte superior de Excel... donde encontramos el nombre del libro de trabajo).
Por defecto, si no establecemos un nombre o si se establece el nombre en blanco (Application.Caption = "") , esta propiedad devuelve el texto "Excel".)

Application.Caption = "Aprendiendo VB con Excelforo"

Otra propiedad curiosa:
5- Application.Cursor: Cambia la tipología del icono del cursor entre:
xlDefault-El puntero predeterminado.
xlIBeam-El puntero en i.
xlNorthwestArrow-El puntero flecha noroeste.
xlWait-El puntero reloj de arena.
La propiedad Cursor no se restablecerá automáticamente cuando la macro termine de ejecutarse.
Debereremos restablecer el puntero xlDefault antes de que la macro detiene su ejecución.

Sub CambioCursor()
'xlDefault .El puntero predeterminado.
'xlIBeam .El puntero en i.
'xlNorthwestArrow .El puntero flecha noroeste.
'xlWait .El puntero reloj de arena.
'La propiedad Cursor no se restablecerá automáticamente cuando la macro termine de ejecutarse.
'Deberá restablecer el puntero xlDefault antes de que la macro detiene su ejecución.

 Application.Cursor = xlIBeam
 For x = 1 To 100
 For y = 1 To 100
    Range("A1").Value = x + y
 Next y
 Next x
 Application.Cursor = xlDefault

End Sub

6- Application.DecimalSeparator: para configurar los separadores decimales o de miles de nuestro libro...

Sub CambioSeparadoresSistema()

Range("A1").Formula = "1,234,567.89"
MsgBox "procedemos al cambio..."

'definimos los nuevos separadores
Application.DecimalSeparator = "-"
Application.ThousandsSeparator = " "
'y aplicamos
Application.UseSystemSeparators = False

End Sub

7- Application.DisplayAlerts: daremos valor True para que Excel muestra ciertos mensajes y avisos mientras se ejecuta una macro; y False para suprimir los mensajes y los mensajes de alerta mientras se ejecuta una macro. Cuando un mensaje requiere una respuesta, Microsoft Excel elige la respuesta predeterminada.

'se cierra el libro y no se solicita al usuario que guarde los cambios. 
'No se guardan los cambios realizado en Libro1.xlsm !!
Application.DisplayAlerts = False 
Workbooks("Libro1.xlsm").Close 
Application.DisplayAlerts = True

8- Application.Caption: valor True si los eventos están habilitados para el objeto especificado.
Asociado normalmente a eventos de nuestra hoja de cálculo o objetos ActiveX
OJO por que no es funcional para eventos dentro de un userForm!!

'En este ejemplo deshabilita los eventos antes de que se guarde un archivo para que no se produce el evento BeforeSave
Application.EnableEvents = False 
ThisWorkbook.Save 
Application.EnableEvents = True

9- Application.ScreenUpdating: True si está activada la actualización/refresco de la pantalla.
Acelera la ejecución de las macros...
Recomendable finalizar nuestra macro dando valor False.

'veamos un ejemplo ocultando columnas
Sub TestAceleración_ScreenUpdating()
Dim elapsedTime(2)
'activamos el refresco de pantalla
Application.ScreenUpdating = True
For i = 1 To 2
     'para el segundo caso lo desactivamos
    If i = 2 Then Application.ScreenUpdating = False
    startTime = Time
    Worksheets("Hoja1").Activate
    'recorremos todas las columnas de la hoja
    For Each c In ActiveSheet.Columns
       'si la columna es par
       If c.Column Mod 2 = 0 Then
           'la ocultamos
           c.Hidden = True
       End If
    Next c
    stopTime = Time
    elapsedTime(i) = (stopTime - startTime) * 24 * 60 * 60
Next i
'lo dejamos activo
Application.ScreenUpdating = True
'y mostramos los tiempos
MsgBox "Tiempo transcurrido, screenupdating ON: " & elapsedTime(1) & " segundos." & vbCrLf & _
 "Tiempo transcurrido, screenupdating OFF: " & elapsedTime(2) & " segundos."
End Sub

Y la última propiedad a comentar (por no eternizar la lista):
10- Application.Visible: True o False para determinar si el objeto (nuestra aplicación) está o no visible a ojos del usuario...

'Hacemos Excel invisible.. pero operativo.
Application.Visible = False

'forzamos la espera de 13 segundos
Application.Wait Now + TimeValue("00:00:13")
'con un mensajito
MsgBox "sigo operativo"

'y terminamos haciendo visible la aplicación
Application.Visible = True

Por supuesto hay muchos más.. y te invito a investigar
;-)

Seguir leyendo...

VBA: Forzar siempre Mayúsculas

En algún foro en el que participo preguntaba un usuario por la manera de obligar al usuario de escribir siempre en mayúsculas.

Iremos un paso más allá, y aprenderemos una forma de forzar las minúsculas o a escribir en modo 'Nombre Propio'.

Una manera sería mediante eventos de hoja, en concreto un evento que detecte que se ha escrito algo en alguna celda. El evento buscado será el Worksheet_Change.
Nuestra macro detectaré el cambio en la celda y, evitando sen una fórmula o función lo que hayamos escrito, procederá al cambio buscado.

En diferentes alternativas usaremos las funciones de VB:
UCASE para mayúsculas
LCASE para minúsculas
podríamos usar la función de hoja de cálculo
Worksheetfunction.PROPER para forma de Nombre Propio

o bien emplear la función de VB
StrConv(string, conversion, [LCID])
siendo el parámetro conversion, entre otras posibilidades:
vbUpperCase - 1 - Convierte la cadena a caracteres en mayúscula.
vbLowerCase - 2 - Convierte la cadena a caracteres en minúscula.
vbProperCase - 3 - Convierte la primera letra de cada palabra de la cadena en mayúscula.

Vemos las opciones comentadas...

En la ventana de código de la hoja incluimos el siguiente evento _Change:

Private Sub Worksheet_Change(ByVal Target As Range)
'Convierte a mayúscula/minúscula cualquier celda de la hoja
'tras aceptar
''''''''''''''''''''''''''''''''''''''''''''

'controlamos no haya más de una celda seleccionada
'o que la celda no tenga fórmulas
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
On Error Resume Next

Application.EnableEvents = False    'deshabilitamos momentáneamente los eventos de la hoja
'convertimos a mayúsculas la celda cambiada
'empleando las funciones de VBA UCASE o LCASE
Target.Value = VBA.UCase(Target.Value)      'LCase(Target.value) para minúsculas
Application.EnableEvents = True     'y los volvemos a habilitar
On Error GoTo 0
End Sub

Una alternativa más 'profesional', también en la ventana de código de la hoja:

Private Sub Worksheet_Change(ByVal Target As Range)
'Convierte a mayúscula la primera letra de cada palabra
'para cualquier celda de la hoja tras Aceptar
''''''''''''''''''''''''''''''''''''''''''''
'controlamos no haya más de una celda seleccionada
'o que la celda no tenga fórmulas
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub

On Error Resume Next
Application.EnableEvents = False    'deshabilitamos momentáneamente los eventos de la hoja
'empleamos la función
'StrConv(string, conversion, [LCID])
'siendo conversion:
'vbUpperCase - 1 - Convierte la cadena a caracteres en mayúscula.
'vbLowerCase - 2 - Convierte la cadena a caracteres en minúscula.
'vbProperCase - 3 - Convierte la primera letra de cada palabra de la cadena en mayúscula.
Target.Value = VBA.StrConv(Target.Value, vbProperCase)
Application.EnableEvents = True      'y los volvemos a habilitar
On Error GoTo 0
End Sub

Otra posibilidad algo más compleja por sus repercusiones sería emplear una API de Windows SetKeyboardState:

Declare Function SetKeyboardState Lib "user32" (lppbKeyState As Byte) As Long
Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long

Sub BloqueoMayuscula()
'OJO!! solo afecta a Excel.. nunca a otras aplicaciones!!
'por tanto cambairá los indicadores luminosos de NUM LOCK, CAPS LOCK o SCROLL LOCK del teclado.

Dim Resultado As Long
'matriz para el estado de las teclas virtuales existentes
Dim EstadoTeclas(0 To 255) As Byte

'Algunas teclas sobre las que trabajar
'Shift = &H10   
'Ctrl = &H11    
'Alt = &H12    
'CapsLock = &H14
'NumLock = &H90
'ScrollLock = &H91

'trabajamos sobre la mayúscula
EstadoTeclas(&H14) = 1 '1 - activa, 0 - desactiva

Resultado = SetKeyboardState(EstadoTeclas(0))

End Sub

Esta macro la podemos asociar al evento Open del Workbook o cualquiera otro mediante el que controlemos la acción deseada...

Seguir leyendo...

VBA: Imitando un vínculo entre hojas

Un lector hace unos días preguntaba por la manera de replicar un vínculo entre hojas.

[...]la idea es que al dar clic en el código de la hoja 1 se llegue al código de la hoja 2 para poder realizar cambios en el precio del articulo[...]

Supongamos tenemos dos hojas de trabajo:
Hoja 'datos' donde tenemos un listado de los productos y sus precios (donde queremos que nos lleve el 'vínculo')
Hola 'PPAL' donde usamos en cada registro los códigos necesitados

El objetivo consiste en que al seleccionar las celdas del rango B2:B13 de la hoja 'PPAL' nos traslade a la hoja 'datos' y en concreto a la celda donde se encuentre el 'artículo' seleccionado.

Para ello usaremos un evento de programación de la hoja 'PPAL', donde combinando métodos de trabajo como .Find o Intersect, y a través de un bucle (Do...Loop) terminamos haciendo un .Select sobre la celda buscada en la hoja 'datos'.

En la ventana de código de la hoja principal incluimos el siguiente procedimiento:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'evitamos el fallo si se seleccionan varias celdas...
If Target.Count > 1 Then Exit Sub

'verificamos que sólo actue si nos encontramos en las columnas X ó Y
If Not Intersect(Target, Range("B2:B13")) Is Nothing Then
    'depuramos posibles errores, en caso que la celda está vacía salimos de la rutina
    If Target.Value = "" Then
        Exit Sub
    Else
        'buscamos la ubicación en la hoja datos
        With Worksheets("datos").Range("A:A")
            Set c = .Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    'en la coincidencia seleccionamos la hoja
                    Sheets("datos").Select
                    'y la celda encontrada
                    c.Select
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
    End If
End If

End Sub

Listo para probar...

Seguir leyendo...

Método Newton-Rapshon en la hoja de cálculo

En la entrada anterior del blog vimos como con un poco de programación resolvíamos o encontrábamos la raíz de una ecuación basándonos en el método de Newton-Raphson.
Hoy analizaremos el mismo problema pero sin macros, solo empleando funciones directamente en la hoja de cálculo.

Nuestra función principal, de la que queremos conocer su raíz será:
f(x)=3x²-5
siendo su función derivada:
f'(x)=6x

Si construimos un gráfico de nuestra función
f(x)=3x²-5
veríamos:

Gráficamente ya intuimos cuál es la raíz de nuestra ecuación (una de ellas)... muy cercana a 1,3.

Para llegar a esa solución aplicando el método de Newton-Raphson generamos un rango con cinco columnas:
1- Columna B (B4:B14): valores de 0 a 10

2- columna C (C4:C14): añadimos el algoritmo descrito por el método:
x_n+1=x_n-f(x_n) / f'(x_n)
En nuestro caso en C4 incluimos un valor inicial fijo, pero en C5 añadimos la fórmula:
=C4-D4/E4
y arrastramos hasta C14.

3- columna D (D4:D14): añadimos la fórmula que responde a nuestra función principal:
=(3*C4^2)-5
y arrastramos hasta D14.

4- columna E (E4:E14): añadimos la fórmula que responde a nuestra función derivada:
=6*C4
y arrastramos hasta E14.

5- columna F (F5:F14): añadimos la fórmula que corresponde con el error calculado. En F5
=ABS(C5-C4)
y arrastramos hasta F14.

haz clic en la imagen

Comprobamos en nuestro cálculo como en la quinta iteración el resultado encontrado
1,290994448735810
responde con un error de cero.
Lo que nos diría que esa es la raíz de nuestra ecuación.

Seguir leyendo...