Следующий подход использует обходной путь, описанный здесь и здесь для того, чтобы функция рабочего листа, определенная в VBA, могла установить значение другой ячейки.
Настраиваемая функция хранит в глобальных переменных адрес целевой ячейки и значение, на которое эта ячейка должна быть установлена. Затем, макрос, который запускается, когда рабочий лист заново вычисляет прочитанные глобальные переменные и устанавливает целевую ячейку на указанное значение.
Использовать пользовательскую функцию просто:
=SetCellValue(target_cell, value)
где target_cell
- это строковая ссылка на ячейку в рабочем листе (например, “A1”) или выражение, которое вычисляет такую ссылку. Это включает в себя выражение, такое как =B14
, где значение B14 равно “A1”. Функция может быть использована в любом корректном выражении.
SetCellValue
возвращает 1, если значение успешно записано в целевую ячейку, и 0 в противном случае. Любое предыдущее содержимое целевой ячейки перезаписывается.
Требуется три куска кода:
- код, определяющий сам
SetCellValue
- макрос, вызываемый событием вычисления рабочего листа; и
- утилита-функция
IsCellAddress
, гарантирующая, что target_cell
является действительным адресом ячейки.
Код функции SetCellValue Function
Этот код необходимо вставить в стандартный модуль, вставляемый в рабочую книгу. Модуль может быть вставлен через меню редактора Visual Basic, доступное при выборе Visual Basic
на закладке Developer
ленты.
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
Этот код должен быть включен в код, специфичный для рабочего листа, в котором вы будете использовать SetCellValue
. Самый простой способ сделать это - щелкнуть правой кнопкой мыши по закладке рабочего листа в окне Home
, выбрать View Code
, а затем вставить код в появившуюся панель редактора.
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
Код IsCellAddress Function
Этот код можно вставить в тот же модуль, что и код 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