VBA разделить на 1000 без удаления формулы

Question

В настоящее время я использую этот базовый код для деления значения ячейки на 1000:

Sub Divide_by_1000()
    Dim cell As Range
    For Each cell In Selection
        cell = cell / 1000
    Next
End Sub

Хотя он работает очень хорошо для жестко закодированных чисел, если используется в ячейке с формулой в ней, она удаляет формулу и выводит число.

В идеале я хотел бы, чтобы макрос работал так же, как и для ячейки с числом в нем, но для ячейки с формулой я бы хотел, чтобы она была перенесеназаключите в скобки текущую формулу и поставьте /1000 в конце (т.е. сохраняя формулу в такте)

Я считаю, что нужно будет проверить, проверяет ли ячейка формулу и применитькод, который у меня уже есть, если его нет, и код, который я изложил выше, если он есть.

Любая помощь будет принята с благодарностью.

Answer 1

Диапазон / ячейку можно проверить для формул, используя свойство HasFormula, например,

Dim TheArea as range
Set TheArea = range("some name")

If TheArea.HasFormula then
    '  All the cells in the range have a formula
End if

, в качестве альтернативы вы можете использовать свойство specialcells диапазона, например,

For Each Cell In TheArea.SpecialCells(xlCellTypeConstants)
    Cell.Value = cell.Value/1000
Next Cell

For Each Cell In TheArea.SpecialCells(xlCellTypeFormulas)
    Cell.Formula = "=(" & Right$(Cell.Formula, Len(Cell.Formula) - 1) & ")/1000"
Next Cell

Этот подход также даету вас есть возможность обнаружить другие возможные сценарии, например xlCellTypeBlanks, если они важны для вас.Полный список специальных ячеек можно найти здесь ...

https://docs.microsoft.com/en-us/office/vba/api/excel.range.specialcells

Answer 2

После комментариев с @ PEH :

Вы можете использовать .HasFormula и .HasArray для проверки типа формулы

If cell.HasFormula Then
    If cell.HasArray Then
        cell.Offset(0, 1).FormulaArray = "=(" & Right$(cell.FormulaArray, Len(cell.FormulaArray) - 1) & ")/1000"
    Else
        cell.Offset(0, 1).Formula = "=(" & Right$(cell.Formula, Len(cell.Formula) - 1) & ")/1000"
    End If
ElseIf IsNumeric(cell.Value2) Then
    cell.Offset(0, 1).Value2 = cell.Value2 / 1000
End If

Answer 3

Вы можете проверить, имеет ли ячейка формулу, проверив, является ли первый символ знаком равенства =

If Left$(cell.Formula, 1) = "=" Then

или даже лучше

If cell.HasFormula Then

, а затем переписатьформула, расширенная на ( … )/1000

cell.Formula = "=(" & Right$(cell.Formula, Len(cell.Formula) - 1) & ")/1000"

, также я рекомендую проверить, является ли cell.Value числом, прежде чем делить на 1000

ElseIf IsNumeric(cell.Value) Then
   cell.Value = cell.Value / 1000

Таким образом, вы получите что-то вроде

If Left$(cell.Formula, 1) = "=" Then
    cell.Formula = "=(" & Right$(cell.Formula, Len(cell.Formula) - 1) & ")/1000"
ElseIf IsNumeric(cell.Value) Then
    cell.Value = cell.Value / 1000
End If

Обратите внимание, что хотя это будет работать для обычных формул, оно будет разрушать, например, формулы массива.