El siguiente enfoque hace uso de una solución descrita aquí y aquí para permitir que una función de la hoja de cálculo definida en VBA establezca el valor de otra celda.
La función personalizada almacena en variables globales la dirección de la celda de destino y el valor al que se va a establecer dicha celda. Luego, una macro que se activa cuando la hoja de trabajo recalcula lee las variables globales y establece la celda de destino al valor especificado.
El uso de la función personalizada es sencillo:
=SetCellValue(target_cell, value)
donde target_cell es una referencia de cadena a una celda de la hoja de cálculo (por ejemplo, “A1”) o una expresión que se evalúa a dicha referencia. Esto incluye una expresión como =B14 donde el valor de B14 es “A1”. La función puede utilizarse en cualquier expresión válida.
SetCellValue devuelve 1 si el valor se escribe con éxito en la celda de destino, y 0 en caso contrario. Cualquier contenido anterior de la celda de destino se sobrescribe.
Se necesitan tres piezas de código:
- el código que define a
SetCellValue en sí mismo
- la macro que es lanzada por el evento de cálculo de la hoja de trabajo; y
- una función de utilidad
IsCellAddress para asegurar que target_cell es una dirección de celda válida.
Código para la función SetCellValue
Este código necesita ser pegado en un módulo estándar insertado en el libro de trabajo. El módulo se puede insertar a través del menú del editor de Visual Basic, al que se accede seleccionando Visual Basic en la pestaña Developer de la cinta de opciones.
Option Explicit
Public triggerIt As Boolean
Public theTarget As String
Public theValue As Variant
Function SetCellValue(aCellAddress As String, aValue As Variant) As Long
If (IsCellAddress(aCellAddress)) And _
(Replace(Application.Caller.Address, "$", "") <> _
Replace(UCase(aCellAddress), "$", "")) Then
triggerIt = True
theTarget = aCellAddress
theValue = aValue
SetCellValue = 1
Else
triggerIt = False
SetCellValue = 0
End If
End Function
Worksheet_Calculate Macro Code
Este código debe incluirse en el código específico de la hoja de trabajo en la que se va a utilizar el SetCellValue. La forma más fácil de hacerlo es hacer clic con el botón derecho del ratón en la pestaña de la hoja de trabajo en la vista Home, seleccionar View Code, y luego pegar el código en el panel del editor que aparece.
Private Sub Worksheet_Calculate()
If Not triggerIt Then
Exit Sub
End If
triggerIt = False
On Error GoTo CleanUp
Application.EnableEvents = False
Range(theTarget).Value = theValue
CleanUp:
Application.EnableEvents = True
Application.Calculate
End Sub
Código para la función IsCellAddress
Este código se puede pegar en el mismo módulo que el código SetCellValue.
Function IsCellAddress(aValue As Variant) As Boolean
IsCellAddress = False
Dim rng As Range ' Input is valid cell reference if it can be
On Error GoTo GetOut ' assigned to range variable
Set rng = Range(aValue)
On Error GoTo 0
Dim colonPos As Long 'convert single cell "range" address to
colonPos = InStr(aValue, ":") 'single cell reference ("A1:A1" -> "A1")
If (colonPos <> 0) Then
If (Left(aValue, colonPos - 1) = _
Right(aValue, Len(aValue) - colonPos)) Then
aValue = Left(aValue, colonPos - 1)
End If
End If
If (rng.Rows.Count = 1) And _
(rng.Columns.Count = 1) And _
(InStr(aValue, "!") = 0) And _
(InStr(aValue, ":") = 0) Then
IsCellAddress = True
End If 'must be single cell address in this worksheet
Exit Function
GetOut:
End Function