Click en dibujo que pase de celda B8 a B7 (celda superior)
Tengo una lista de números que va de la celda B1 a B10 en la hoja1. Quisiera una macro que al hacer click en un dibujo de flecha pase el valor de B8 a la celda D4 de la hoja llamada Principal. Al próximo click sea el valor de B7 (celda superior) y así hasta el primer valor de la lista.
Tengo una macro que se desplaza hacia las celdas inferiores así:
Sub pasar_Valor()
'Por Dante Amor
'
Dim cel_destino As Range, rng_origen As Range, f As Range
Dim ultima As String, valor As Variant
'
Set rng_origen = Sheets("hoja1").Range("B1:B10") 'rango origen
Set cel_destino = Sheets("Principal").Range("D4") 'celda destino
'
ultima = rng_origen.Cells(rng_origen.Rows.Count, 1).Address
If cel_destino.Value = "" Then
'si la celda destino está vacía, entonces pone el primer valor
valor = rng_origen.Cells(1).Value
Else
Set f = rng_origen.Find(cel_destino.Value, , xlValues, xlWhole, , , False)
If f Is Nothing Then
'si el dato de la celda destino no existe en B1:B10, entonces pone el primer valor
valor = rng_origen.Cells(1).Value
Else
If f.Address = ultima Then
'si el dato encontrado es el último de rango, entonces pone el primer valor
valor = rng_origen.Cells(1).Value
Else
valor = f.Offset(1).Value
End If
End If
End If
cel_destino.Value = valor
End Sub
1 Respuesta
Respuesta de Dante Amor
1
V i s i t a:
Prueba lo siguiente:
Sub pasar_Valor()
'Por Dante Amor
'
Dim cel_destino As Range, rng_origen As Range
Dim ultima As String
'
Set rng_origen = Sheets("hoja1").Range("B1:B10") 'rango origen
Set cel_destino = Sheets("Principal").Range("D4") 'celda destino
'
ultima = rng_origen.Cells(rng_origen.Rows.Count, 1).Address
'
If Not Intersect(ActiveCell, rng_origen) Is Nothing And ActiveCell.Address <> "$B$1" Then
ActiveCell.Offset(-1).Select
Else
Range(ultima).Select
End If
'
cel_destino.Value = ActiveCell.Value
End SubRecomendación del día:
Consejos para desarrollar macros - YouTube
Sal u dos
