可以通过”选择性粘贴“来实现这个目的。
例如：数字2528957646在A1单元格，0.1在C1单元格，
第一步：选中C1单元格，右键，复制，
第二步:选中A1单元格，右键，选择性粘贴，减，确定就好，结果如图；
前几个月在淘宝上接单做的一个小插件，在这里分享一下。代码如下：
Public Sub MY_plus(control As IRibbonControl)
Call P_Plus
End Sub
Public Sub MY_minus(control As IRibbonControl)
Call P_Minus
End Sub
Sub P_Plus() '加
Dim S As String
Dim Arr
Dim Gs As Integer
Dim SZArr() As Double
Dim M As Integer
Dim HSBj As String
S = GetClipBoardString
If S = "" Then Exit Sub
If InStr(S, Chr(9)) > 0 Then
HSBj = "H" '横向
Else
If InStr(S, Chr(10)) > 0 Then
HSBj = "S" '竖向
Else
HSBj = "Y" '仅一个
End If
End If
Select Case HSBj
Case "H"
Arr = Split(S, Chr(9))
Gs = UBound(Arr) + 1
ReDim SZArr(1 To Gs)
For M = 1 To Gs
SZArr(M) = Val(Arr(M - 1))
Next M
Case "S"
Arr = Split(S, Chr(10))
Gs = UBound(Arr)
ReDim SZArr(1 To Gs)
For M = 1 To Gs
SZArr(M) = Val(Arr(M - 1))
Next M
Case "Y"
Gs = 1
ReDim SZArr(1 To 1)
SZArr(1) = Val(S)
End Select
If Gs = 0 Then Exit Sub
Dim myR As Range
Dim M_Addr As String, myT As String
Dim ksHH As Integer, jsHH As Integer, Hh As Integer
Dim ksLH As Integer, jsLH As Integer, Lh As Integer
Dim M_ksA As String, M_jsA As String
M_Addr = Selection.Address
Arr = Split(M_Addr, ",")
For M = 0 To UBound(Arr)
myT = Arr(M)
M_ksA = Split(myT, ":")(0)
M_jsA = Split(myT, ":")(1)
ksHH = Range(M_ksA).Row
ksLH = Range(M_ksA).Column
jsHH = Range(M_jsA).Row
jsLH = Range(M_jsA).Column
If jsLH - ksLH + 1 = Gs Then
For Hh = ksHH To jsHH
For Lh = ksLH To jsLH
If IsNumeric(Cells(Hh, Lh)) Then
Cells(Hh, Lh) = Cells(Hh, Lh).Value + SZArr(Lh - ksLH + 1)
End If
Next Lh
Next Hh
End If
Next M
End Sub
Private Function GetClipBoardString() As String
On Error Resume Next
Dim MyData As New DataObject
GetClipBoardString = ""
MyData.GetFromClipboard
GetClipBoardString = MyData.GetText
Set MyData = Nothing
End Function
Sub P_Minus() '减
Dim S As String
Dim Arr
Dim Gs As Integer
Dim SZArr() As Double
Dim M As Integer
Dim HSBj As String
S = GetClipBoardString
If S = "" Then Exit Sub
If InStr(S, Chr(9)) > 0 Then
HSBj = "H" '横向
Else
If InStr(S, Chr(10)) > 0 Then
HSBj = "S" '竖向
Else
HSBj = "Y" '仅一个
End If
End If
Select Case HSBj
Case "H"
Arr = Split(S, Chr(9))
Gs = UBound(Arr) + 1
ReDim SZArr(1 To Gs)
For M = 1 To Gs
SZArr(M) = Val(Arr(M - 1))
Next M
Case "S"
Arr = Split(S, Chr(10))
Gs = UBound(Arr)
ReDim SZArr(1 To Gs)
For M = 1 To Gs
SZArr(M) = Val(Arr(M - 1))
Next M
Case "Y"
Gs = 1
ReDim SZArr(1 To 1)
SZArr(1) = Val(S)
End Select
If Gs = 0 Then Exit Sub
Dim myR As Range
Dim M_Addr As String, myT As String
Dim ksHH As Integer, jsHH As Integer, Hh As Integer
Dim ksLH As Integer, jsLH As Integer, Lh As Integer
Dim M_ksA As String, M_jsA As String
M_Addr = Selection.Address
Arr = Split(M_Addr, ",")
For M = 0 To UBound(Arr)
myT = Arr(M)
M_ksA = Split(myT, ":")(0)
M_jsA = Split(myT, ":")(1)
ksHH = Range(M_ksA).Row
ksLH = Range(M_ksA).Column
jsHH = Range(M_jsA).Row
jsLH = Range(M_jsA).Column
If jsLH - ksLH + 1 = Gs Then
For Hh = ksHH To jsHH
For Lh = ksLH To jsLH
If IsNumeric(Cells(Hh, Lh)) Then
Cells(Hh, Lh) = Cells(Hh, Lh).Value - SZArr(Lh - ksLH + 1)
End If
Next Lh
Next Hh
End If
Next M
End Sub
使用方法：问题如图
第一步选择B2复制
第二步选择D2:D5,点击+按钮，结果：
第一步：在空白单元格中输入0.01并复制；
第二步：选中这一千多个单元格，单击鼠标右键选择“选择性粘贴”命令；
第三步：在弹出的对话框中的“运算”区域选择“减”单选按钮，单击“确定”按钮。
如果不要前面的数字，可以复制，粘贴数值。