excel - 将所有填充单元格更改为值而不是公式的 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