VBA - 粘贴为数值型

Private Sub PasteValue()
'粘贴为数值型

Application.ScreenUpdating = False  '关闭屏幕刷新

    Dim Rng As Range
    '选择单个单元格时，只粘贴使用ActiveCell区域
    Set Rng = IIf(Selection.Count > 1, Selection.SpecialCells(xlCellTypeVisible), ActiveCell)

    '循环选择的可见区域
    For Each r In Rng
        ' 转为数值型
        ' 方式1 - 速度快 - 文本类型需修改单元格格式
        ' 设置文本型
        If TypeName(r.Value2) = "String" Then
            r.NumberFormatLocal = "@"
        End If
        r.Value = r.Value

        ' 方式2 - 速度慢 - 结果好
        ' r.Copy
        ' r.PasteSpecial Paste:=xlValues

    Next
    ' 取消拷贝状态 - 方式2
    ' Application.CutCopyMode = False


Application.ScreenUpdating = True   '开启屏幕刷新
End Sub