Макрос Excel, который заменяет все заполненные ячейки на значения вместо формулы

Question

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

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

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

Есть предложения?

Answer 1

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

    '~~~> Copy/Paste (keeping the values and formats)
    rCell.Copy
    rCell.PasteSpecial (xlPasteValuesAndNumberFormats)

    '~~~> Clear marching ants
    Application.CutCopyMode = False

Это то, как найти номер столбца последнего не-пустая ячейка в строке (отличается от поиска последней пустой ячейки).

    lCol = .Find("*", , xlValues, , xlByColumns, xlPrevious).Column

Зацикливание только строк в используемом диапазоне сэкономит время при использовании больших наборов данных.

With rUsedRng

    '~~~> Loop each row in the used range
    For Each rRow In .Rows

        '~~~> Do something here.
        MsgBox "Ready for action on this row"

    Next

End With

Этоэто то, как вы можете собрать все это вместе.

Sub FormulasToValues_LastCellInRow()

'~~~> Optimize speed
With Application

    .ScreenUpdating = False
    .DisplayAlerts = False

End With

'~~~> Declare the variables
Dim ws As Worksheet
Dim rUsedRng As Range
Dim rRow As Range
Dim rCell As Range
Dim lCol As Long

'~~~> Set the variables
Set ws = ActiveSheet
Set rUsedRng = ws.UsedRange
'Debug.Print "rUsedRng = " & rUsedRng.Address

With rUsedRng

    '~~~> Loop each row in the used range
    For Each rRow In .Rows

        '~~~> Find the last non-blank cell (not the last empty cell)
        lCol = .Find("*", , xlValues, , xlByColumns, xlPrevious).Column

        '~~~> Set the range to be copied.
        Set rCell = ws.Cells(rRow.Row, lCol)
        'Debug.Print "rCell = " & rCell.Address

        '~~~> Copy/Paste (keeping the values and formats)
        rCell.Copy
        rCell.PasteSpecial (xlPasteValuesAndNumberFormats)

        '~~~> Clear marching ants
        Application.CutCopyMode = False

    Next

End With

'~~~> Release Variables from Memory
Set ws = Nothing
Set rUsedRange = Nothing
Set rCell = Nothing
lCol = vbNull

'~~~> Reset application items
With Application

    .ScreenUpdating = True
    .DisplayAlerts = True

End With

End Sub

Перед данными

После данных

Answer 2

Кажется, этот саб делает то, что вы хотите. Или есть что-то еще?

Обратите внимание, что строка cell.select предназначена для пошагового выполнения кода и должна быть удалена после того, как вы убедитесь, что он работает для вас.

Sub replaceFormula()
Dim cell As Range
For Each cell In UsedRange
    cell.Select
     If cell.Offset(, 1) = "" And InStr(cell.Formula, "=") Then
        cell.Value = cell
    End If
Next
End Sub