Il seguente approccio fa uso di un workaround descritto qui e qui per permettere a una funzione del foglio di lavoro definita in VBA di impostare il valore di un'altra cella.
La funzione personalizzata memorizza in variabili globali l'indirizzo della cella di destinazione e il valore a cui quella cella deve essere impostata. Poi, una macro che viene attivata quando il foglio di lavoro ricalcola legge le variabili globali e imposta la cella di destinazione al valore specificato.
L'uso della funzione personalizzata è semplice:
=SetCellValue(target_cell, value)
dove target_cell è un riferimento a una cella del foglio di lavoro (per esempio, “A1”) o un'espressione che valuta un tale riferimento. Questo include un'espressione come =B14 dove il valore di B14 è “A1”. La funzione può essere usata in qualsiasi espressione valida.
SetCellValue restituisce 1 se il valore viene scritto con successo nella cella di destinazione, e 0 altrimenti. Qualsiasi contenuto precedente della cella di destinazione viene sovrascritto.
Sono necessari tre pezzi di codice:
- il codice che definisce
SetCellValue stesso
- la macro che viene attivata dall'evento di calcolo del foglio di lavoro; e
- una funzione di utilità
IsCellAddress per assicurare che target_cell sia un indirizzo di cella valido.
Codice per la funzione SetCellValue
Questo codice deve essere incollato in un modulo standard inserito nella cartella di lavoro. Il modulo può essere inserito tramite il menu dell'editor di Visual Basic, a cui si accede selezionando Visual Basic dalla scheda Developer del nastro.
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
Questo codice deve essere incluso nel codice specifico del foglio di lavoro in cui userete SetCellValue. Il modo più semplice per farlo è cliccare con il tasto destro del mouse sulla scheda del foglio di lavoro nella vista Home, selezionare View Code, e poi incollare il codice nel pannello dell'editor che si apre.
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
Codice per la funzione IsCellAddress
Questo codice può essere incollato nello stesso modulo del codice 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