发帖
雷达卡
各位是否在工作中经常遇到这种烦人的情况,面对一堆公式或数字,需要保留2位小数,或者要把错误值取0,工作简单但是超级烦琐。
终于我忍无可忍，决定编几个小程序,可以作为自定义按钮放在工具栏上，再有这样的工作就一键OK了。
因为本人才疏学浅，所以程序可能有不完善之处，欢迎各位达人来拍砖。并且自己编制的宏，运行后无法再使用excel的自动后退功能，所以使用请慎重。
使用方法如下：
将程序复制到个人工作簿的模块中，这样每次开启excel都可以自动加载（个人工作簿在窗口-取消隐藏中找到，复制程序后可以重新隐藏。如果找不到，可以先任意录制宏，保存在个人工作簿中，再按上述方法操作）。
然后在工具-自定义-工具栏，新建一个工具栏，定义名称，然后选类别-宏，将右侧自定义按钮拖入刚才定义的工具栏，右键：命名，更改按钮图像，指定宏。
大功告成，选定你想操作的区域,点击自定义的按纽,就可以工作了。
共有3个程序，分别是自动保留几位小数，取消保留几位小数公式和错误值取0。
Sub autoaddround()
'适用于空值，数值和公式，自动保留小数
Dim a As Integer
Dim mycell As Range, b As String, d As String, c As String
a = InputBox("保留几位小数")
For Each mycell In Selection
mycell.Select
b = ActiveCell.Formula
d = Left(b, 1)
If ActiveCell.Value <> "" Then '当单元格非空时运算
If d = "=" Then '当单元格是公式
c = Right(b, Len(b) - 1)
ActiveCell.Formula = "=round(" & c & "," & a & ")"
ElseIf TypeName(ActiveCell.Value) <> "String" Then '当单元格非字符,也就是数字
ActiveCell.Formula = "=round(" & b & "," & a & ")"
End If
End If
Next
End Sub
Sub unround()
'取消自动保留小数的公式
Dim mycell As Range
Dim b As String
Dim c As Integer
For Each mycell In Selection
mycell.Select
b = ActiveCell.Formula
If Left(b, 6) = "=ROUND" Then
c = Application.WorksheetFunction.Find(",", b, Len(b) - 4)
ActiveCell.Formula = "=" & Mid(b, 8, c - 8)
End If
Next
End Sub
Sub errortozero()
'当单元格为公式时,才取0,数值则不行
Dim a As Integer
Dim mycell As Range
a = MsgBox("值错误取0。值正确，选Yes,取原值;选No,取1", vbYesNoCancel, "错误值取0")
If a <> 2 Then '当选cancel时,不运行
For Each mycell In Selection
mycell.Select
b = ActiveCell.Formula
d = Left(b, 1)
If a = 6 Then '当选yes时
If ActiveCell.Value <> "" Then
If d = "=" Then
c = Right(b, Len(b) - 1)
ActiveCell.Formula = "=if(iserror(" & c & "),0," & c & ")"
End If
End If
ElseIf a = 7 Then '当选no时
If ActiveCell.Value <> "" Then
If d = "=" Then
c = Right(b, Len(b) - 1)
ActiveCell.Formula = "=if(iserror(" & c & "),0,1)"
End If
End If
End If
Next
End If
End Sub
京公网安备 11010802022788号
