De volgende aanpak maakt gebruik van een workaround die hier en hier zijn beschreven om een in VBA gedefinieerde werkbladfunctie in staat te stellen de waarde van een andere cel in te stellen.
De aangepaste functie slaat in globale variabelen het adres op van de doelcel en de waarde waarop die cel moet worden ingesteld. Vervolgens leest een macro die wordt geactiveerd wanneer het werkblad opnieuw wordt berekend, de globale variabelen uit en stelt de doelcel in op de opgegeven waarde.
Het gebruik van de aangepaste functie is eenvoudig:
=SetCellValue(target_cell, value)
waarbij target_cell
een tekenreeksverwijzing is naar een cel in het werkblad (bijv. “A1”) of een uitdrukking die evalueert naar een dergelijke verwijzing. Dit omvat een uitdrukking zoals =B14
waarbij de waarde van B14 “A1” is. De functie kan in elke geldige uitdrukking worden gebruikt.
SetCellValue
retourneert 1 als de waarde met succes naar de doelcel is geschreven, en 0 anders. Eventuele eerdere inhoud van de doelcel wordt overschreven.
Er zijn drie stukjes code nodig:
- de code die
SetCellValue
zelf definieert
- de macro die getriggerd wordt door de werkbladberekeningsgebeurtenis; en
- een utiliteitsfunctie
IsCellAddress
om te verzekeren dat target_cell
een geldig celadres is.
Code voor SetCellValue Functie
Deze code moet in een standaardmodule worden geplakt die in het werkboek wordt ingevoegd. De module kan worden ingevoegd via het menu voor de Visual Basic editor, dat toegankelijk is door Visual Basic
te selecteren op het tabblad Developer
van het lint.
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
Deze code moet worden opgenomen in de code die specifiek is voor het werkblad waarin u SetCellValue
gaat gebruiken. De eenvoudigste manier om dit te doen is met de rechtermuisknop te klikken op het tabblad van het werkblad in de Home
-weergave, View Code
te selecteren, en dan de code te plakken in het deelvenster editor dat verschijnt.
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
Code voor IsCellAddress Functie
Deze code kan in dezelfde module geplakt worden als de SetCellValue
code.
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