Я собираюсь предположить, что вы хотите выполнить преобразование для входной ячейки, а не все ваши ячейки являются формулами, и что многие ячейки, которые вы хотите преобразовать, являются значениями. Вы должны серьезно продумать ответ, чтобы отделить ввод от дисплея, он будет намного более надежным и защищенным от любой логики, которая может сломать вашу рабочую книгу.
Если вы заинтересованы в этом пате, сделайте следующее, но, прежде чем вы сделаете ... РЕЗЕРВНАЯ РАБОТА С ВАШЕЙ РАБОЧЕЙ КНИГИ . Любые тесты, которые я провел с приведенным ниже кодом, не нарушаются, но у меня нет вашей рабочей книги, поэтому я не даю никаких гарантий.
Во-первых, вам нужна ячейка, которая показывает текущий курс обмена. Вам нужно присвоить этой ячейке именованный диапазон ExchangeRate .
В моей книге эта ячейка содержит формулу ...
=IF(B1="USD",1,3.68)
Похоже на это ...
... и к ячейке B1 прикреплена проверка, позволяющая выбрать одну из 2 валют: AED или USD .
Вы сказали, что хотите быть в состоянии гарантировать, что будет преобразован только выбор ячеек. Чтобы убедиться, что мы обнесем забором только эти ячейки, вам нужно создать именованный диапазон НА КАЖДОМ ЛИСТЕ , который включает все эти ячейки.
Имя этого диапазона должно называться CellsToConvert , и вы можете сделать это через менеджер имен. При создании именованного диапазона, убедитесь, что вы указали рабочий лист, для которого вы его создаете, не выбирайте параметр «Рабочая книга».
... ниже показан эпизодический диапазон, который я использовал на первом листе. Все цветные клетки являются частью этого диапазона. Зеленые ячейки содержат значения, а желтые ячейки содержат формулы.
В конце концов, этот диапазон может быть огромным для разных листов, но он должен работать.
Теперь добавьте следующий код в объект ThisWorkbook в редакторе VBA ...
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim objCell As Range, dblExRate As Double, strFormula As String, objSheet As Worksheet
Dim strNewFormula As String, strOpeningChar As String, bIsFormula As Boolean
Dim objCells As Range, strError As String, strExRateRangeName As String
strExRateRangeName = "ExchangeRate"
dblExRate = Range(strExRateRangeName)
Application.EnableEvents = False
For Each objSheet In Worksheets
On Error Resume Next
strError = ""
Err.Clear
Set objCells = objSheet.Range("CellsToConvert")
strError = Err.Description
On Error GoTo 0
If strError = "" Then
For Each objCell In objCells
strFormula = objCell.FormulaR1C1
bIsFormula = False
' Check to make sure this field contains a formula.
If Left(strFormula, 1) = "=" And objCell.NumberFormat <> "@" Then
bIsFormula = True
End If
If dblExRate = 1 Then
' Base currency selected.
' Check to see if the cell contains a formula, if it does,
' convert it back to a value
If bIsFormula Then
' It's a formula and the cell is not set to text, proces it back
' to its original value, that could still be a formula.
' Remove all of the exchange rate components we would've added as
' a part of this routine.
strNewFormula = Replace(strFormula, ") * " & strExRateRangeName, "")
' Check to see if the formula has changed against the previous statement,
' if it has, then it contained the custom additions, otherwise, it didn't.
If strFormula <> strNewFormula Then
strNewFormula = Mid(strNewFormula, 3)
' Check to see if the new value is numeric, if it is, remove the leading
' equals sign as it wasn't originally a formula, or, at least it doesn't
' need to be a formula.
If IsNumeric(strNewFormula) Then
objCell.Value = strNewFormula
Else
objCell.FormulaR1C1 = "=" & strNewFormula
End If
End If
End If
Else
' Something other than the base currency has been selected.
strNewFormula = objCell.FormulaR1C1
If InStr(1, strNewFormula, strExRateRangeName, vbTextCompare) = 0 Then
If bIsFormula Then strNewFormula = Mid(objCell.FormulaR1C1, 2)
objCell.FormulaR1C1 = "=(" & strNewFormula & ") * " & strExRateRangeName
End If
End If
Next
End If
Next
Application.EnableEvents = True
End Sub
... как только вы сделали все вышеперечисленное, это должно сработать для вас. Производительность можно проверить, если книга большая, но это то, что вам нужно проверить самостоятельно.
Если вы измените ячейку, и она находится в одном из этих диапазонов, а валюта USD не выбрана, вы увидите, что значение ввода изменилось на формулу после того, как вы нажали ввод. Это довольно здорово, когда вы думаете об этом, но, возможно, не для вас.
Последнее, что следует отметить, , если ваш диапазон содержит неработающие ссылки, расчет для этого листа не удастся, и мой код не уведомит вас об этом.
Это добавляет другой вариант для вас, но более рискованно, чем первый ответ. Там нет ничего, как варианты. : -)