A abordagem a seguir faz uso de uma solução alternativa descrita aqui e aqui para ativar um função de planilha definida no VBA para definir o valor de outra célula.
A função personalizada armazena em variáveis globais o endereço da célula de destino e o valor para o qual essa célula deve ser definida. Em seguida, uma macro que é acionada quando a planilha recalcula lê as variáveis globais e define a célula de destino como o valor especificado.
O uso da função personalizada é simples:
=SetCellValue(target_cell, value)
onde target_cell é uma referência de string para uma célula na planilha (por exemplo, "A1") ou uma expressão que avalia essa referência. Isso inclui uma expressão como =B14 , em que o valor de B14 é "A1". A função pode ser usada em qualquer expressão válida.
SetCellValue retorna 1 se o valor for gravado com sucesso na célula de destino e 0 caso contrário. Qualquer conteúdo anterior da célula de destino é sobrescrito.
Três trechos de código são necessários:
- o código que define
SetCellValueem si - a macro que é acionada pelo evento de cálculo da planilha; e
- uma função de utilitário
IsCellAddresspara garantir quetarget_cellseja um endereço de célula válido.
Código para a função SetCellValue
Esse código precisa ser colado em um módulo padrão inserido na pasta de trabalho. O módulo pode ser inserido por meio do menu do editor do Visual Basic, que é acessado selecionando Visual Basic na guia Developer da faixa de opções.
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
Esse código deve ser incluído no código específico da planilha na qual você usará SetCellValue . A maneira mais fácil de fazer isso é clicar com o botão direito do mouse na guia da planilha na exibição Home , selecionar View Code e depois colar o código no painel do 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 a função IsCellAddress
Este código pode ser colado no mesmo módulo que o 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