Der folgende Ansatz nutzt den hier und hier beschriebenen Workaround, um eine in VBA definierte Arbeitsblattfunktion in die Lage zu versetzen, den Wert einer anderen Zelle zu setzen.
Die benutzerdefinierte Funktion speichert in globalen Variablen die Adresse der Zielzelle und den Wert, auf den diese Zelle gesetzt werden soll. Dann liest ein Makro, das bei der Neuberechnung des Arbeitsblatts ausgelöst wird, die globalen Variablen und setzt die Zielzelle auf den angegebenen Wert.
Die Verwendung der benutzerdefinierten Funktion ist einfach:
=SetCellValue(target_cell, value)
, wobei target_cell eine String-Referenz auf eine Zelle im Arbeitsblatt (z. B. “A1”) oder ein Ausdruck ist, der zu einer solchen Referenz ausgewertet wird. Dies schließt einen Ausdruck wie =B14 ein, wobei der Wert von B14 “A1” ist. Die Funktion kann in jedem gültigen Ausdruck verwendet werden.
SetCellValue gibt 1 zurück, wenn der Wert erfolgreich in die Zielzelle geschrieben wurde, und ansonsten 0. Ein eventuell vorheriger Inhalt der Zielzelle wird überschrieben.
Es werden drei Codeteile benötigt:
- der Code, der
SetCellValue selbst definiert,
- das Makro, das durch das Arbeitsblattberechnungsereignis ausgelöst wird, und
- eine Hilfsfunktion
IsCellAddress, um sicherzustellen, dass target_cell eine gültige Zelladresse ist.
Code für SetCellValue-Funktion
Dieser Code muss in ein Standardmodul eingefügt werden, das in die Arbeitsmappe eingefügt wird. Das Modul kann über das Menü für den Visual Basic-Editor eingefügt werden, das durch Auswahl von Visual Basic auf der Registerkarte Developer des Menübandes aufgerufen wird.
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
Dieser Code muss in den spezifischen Code des Arbeitsblatts eingefügt werden, in dem Sie SetCellValue verwenden werden. Am einfachsten geht das, indem Sie in der Home-Ansicht mit der rechten Maustaste auf die Registerkarte des Arbeitsblatts klicken, View Code auswählen und dann den Code in das sich öffnende Editorfenster einfügen.
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 für IsCellAddress Funktion
Dieser Code kann in das gleiche Modul wie der SetCellValue Code eingefügt werden.
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