此例的功能是选中一个word中的除法横式后,会自动在该横式下方生成该横式的竖式。
被除数和除数既可以是整数,也可以是小数,但是必须是无符号数字。
该例中调用了一个自定义的Sub:aaTihuanF("/","÷"),该Sub的功能是将除号/替换成手写体÷。
该例的特点是根据手写竖式的思路,逐位计算,基本上不存在由于数位太多导致溢出的情况。唯一的Bug是数位太多,被除数和除数不能写在同一行,解决的办法是,将纸张设置足够宽,字体选小字号即可。
代码中用到了3个特殊字符,是我自造的字符,其中
Α表示除法竖式中的丿,宽度为半角字符宽度;
Β表示除法竖式中的横线,线位于字符上方,线宽为半角字符宽度,但是Β本身不占位置,相当于给数字加了一个上划线;
Η是一个不占位置的小数点,方便对齐数字。
Sub 数学除法竖式()
'原创作品,作者:王欢为,WX:13772568903
Dim Str1$, Str2$, Str3$, Str4$, Str5$, Str6$, Str7$, _
Len1&, Len2&, Len3&, Len5&, Kaishi&, Jieshu&, _
Kong1&, Qian1&, Qiuhe1&, Jinwei1, Benwei1, Shang1&, _
Beichushu1$, Chengji1$, Yushu1$, Charu1$, Charu2$
Dim Arr3(0 To 9) As String
Arr3(0) = "0"
Kaishi = Selection.Start
Jieshu = Selection.End
If Jieshu - Kaishi < 3 Then
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
End If
Kaishi = Selection.Start
Jieshu = Selection.End
Call aaTihuanF("/", "÷")
Str1 = " ,,"
'除式中可能会出现的所有字符,出现其他字符则退出
Str2 = Str1 & "1234567890.Η/÷"
For ii = Jieshu - 1 To Kaishi + 1 Step -1
Selection.Start = ii - 1
Selection.End = ii
If InStr(1, Str2, Selection.Text) < 1 Then
GoTo tuichu1
End If
Next
'删除除式中不必要的字符
Selection.Start = Jieshu - 1
Selection.End = Jieshu
If Selection.Text < "0" Or Selection.Text > "9" Then
Jieshu = Jieshu - 1
End If
'在开始处插入÷
Selection.End = Kaishi
Selection.TypeText Text:="÷"
Jieshu = Jieshu + 1
For ii = Jieshu To Kaishi + 1 Step -1
Selection.Start = ii - 1
Selection.End = ii
If InStr(1, Str1, Selection.Text) > 1 Then
'删除空格和逗号
Selection.End = Selection.Start
Selection.Delete
Jieshu = Jieshu - 1
ElseIf Selection.Text = "." Then
'将小数点换成不占位小数点
Selection.End = Selection.Start
Selection.Delete
Selection.TypeText Text:="Η"
ElseIf Selection.Text = "÷" Then
'找到÷的位置
Selection.Start = ii
Selection.End = ii + 1
If Selection.Text = "0" Then
'找到÷0的位置
Selection.Start = ii + 1
Selection.End = ii + 2
Do While Selection.Text = "0"
'将÷00变成÷0
Selection.End = Selection.Start
Selection.Delete
Jieshu = Jieshu - 1
Selection.Start = ii + 1
Selection.End = ii + 2
Loop
If Selection.Text >= "0" And Selection.Text <= "9" Then
'将÷0数字变成÷数字
Selection.Start = ii
Selection.End = ii
Selection.Delete
Jieshu = Jieshu - 1
End If
End If
End If
Next
'删除之前插入的÷
Selection.Start = Kaishi
Selection.End = Kaishi
Selection.Delete
Jieshu = Jieshu - 1
Selection.End = Jieshu
'获取被除数和除数
Str1 = Selection.Text
If InStr(1, Str1, "÷") < 2 Or InStr(1, Str1, "÷") = Len(Str1) Then
GoTo tuichu1
End If
Str2 = Left(Str1, InStr(1, Str1, "÷") - 1)
Str3 = Mid(Str1, InStr(1, Str1, "÷") + 1, Len(Str1))
If InStr(1, Str2, "Η") > 0 Then
Str4 = Left(Str2, InStr(1, Str2, "Η") - 1)
Str5 = Mid(Str2, InStr(1, Str2, "Η") + 1, Len(Str2))
Else
Str4 = Str2
Str5 = ""
End If
If InStr(1, Str3, "Η") > 0 Then
Str6 = Left(Str3, InStr(1, Str3, "Η") - 1)
Str7 = Mid(Str3, InStr(1, Str3, "Η") + 1, Len(Str3))
Else
Str6 = Str3
Str7 = ""
End If
Str3 = Str6 & Str7
For ii = Len(Str5) + 1 To Len(Str7)
Str5 = Str5 & "0"
Next
Len5 = Len(Str5) - Len(Str7)
Str2 = Str4 & Str5
'去除被除数最左侧的0
For ii = 1 To Len(Str2) - 1
If Left(Str2, 1) = "0" Then
Str2 = Right(Str2, Len(Str2) - 1)
Else
Exit For
End If
Next
For ii = Len(Str2) To Len5
Str2 = "0" & Str2
Next
'Len2表示被除数的长度
Len2 = Len(Str2)
'去除除数最左侧的0
For ii = 1 To Len(Str3) - 1
If Left(Str3, 1) = "0" Then
Str3 = Right(Str3, Len(Str3) - 1)
Else
Exit For
End If
Next
'Len3表示除数的长度
Len3 = Len(Str3)
'判断除数不能为0
If Str3 = "0" Then
Rtn = MsgBox("除数不能为0", vbOKCancel, "警告")
GoTo tuichu1
End If
'储存除数的1~9倍数
Arr3(1) = "0" & Str3
For ii = 2 To 9
'Jinwei1用来表示求和的进位或作差的借位,此处为进位
Jinwei1 = 0
For jj = Len(Arr3(1)) To 1 Step -1
'Qiuhe1可能是求和的和,也可能是作差的差,此处是和
Qiuhe1 = Val(Mid(Arr3(ii - 1), jj, 1)) + Val(Mid(Arr3(1), jj, 1)) + Jinwei1
Benwei1 = Qiuhe1 Mod 10
Jinwei1 = Int(Qiuhe1 / 10)
Arr3(ii) = "" & Benwei1 & Arr3(ii)
Next
Next
'去除倍数最左侧的0
For ii = 1 To 9
If Left(Arr3(ii), 1) = "0" Then
Arr3(ii) = Mid(Arr3(ii), 2, Len(Arr3(ii)) - 1)
End If
Next
'书写被除数除以除数竖式
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Kaishi = Selection.Start
Selection.TypeText Text:=Str3 & "Α"
For ii = 1 To Len2
Selection.TypeText Text:="Β" & Mid(Str2, ii, 1)
Next
'Kong1表示从行首位置向右数,Shang1在第几位
Kong1 = Len3 + 2
'Str1用来储存整个商
Str1 = ""
'Beichushu1表示每次实际使用的那一段被除数
Beichushu1 = ""
For ii = 1 To Len2
'之前的余数是空,下一位补一个0还是空;其余情况正常补下一位数字即可
If Beichushu1 = "" And Mid(Str2, ii, 1) = "0" Then
Beichushu1 = ""
Else
Beichushu1 = Beichushu1 & Mid(Str2, ii, 1)
End If
'从9到1依次试商,要求乘积小于等于被除数,第一个满足条件的数就是商,没有合适的就补0
For kk = 9 To 1 Step -1
If Len(Arr3(kk)) = Len(Beichushu1) And Arr3(kk) <= Beichushu1 Then
Exit For
End If
If Len(Arr3(kk)) < Len(Beichushu1) Then
Exit For
End If
Next
Shang1 = kk
Str1 = Str1 & Shang1
If Shang1 = "0" Then
Kong1 = Kong1 + 1
Else
Charu1 = ""
For jj = 1 To Kong1 - Len(Beichushu1)
Charu1 = Charu1 & " "
Next
Charu1 = Charu1 & Beichushu1
For jj = ii + 1 To Len2
Charu1 = Charu1 & " "
Next
Charu2 = Mid(Charu1, 1, Len3)
For jj = Len3 + 1 To Len2 + Len3 + 1
Charu2 = Charu2 & "Β" & Mid(Charu1, jj, 1)
Next
Selection.TypeParagraph
Selection.TypeText Text:=Charu2
Chengji1 = Arr3(Shang1)
Charu1 = ""
For jj = 1 To Kong1 - Len(Chengji1)
Charu1 = Charu1 & " "
Next
Charu1 = Charu1 & Chengji1
For jj = ii + 1 To Len2
Charu1 = Charu1 & " "
Next
Selection.TypeParagraph
Selection.TypeText Text:=Charu1
Kong1 = Kong1 + 1
'Jinwei1用来表示求和的进位或作差的借位,此处为借位
Jinwei1 = 0
'Yushu1表示每一次被除数与乘积的差值
Yushu1 = ""
For jj = Len(Chengji1) To 1 Step -1
Qiuhe1 = 10 + Val(Mid(Beichushu1, jj + Len(Beichushu1) - Len(Chengji1), 1)) - Val(Mid(Chengji1, jj, 1)) - Jinwei1
Benwei1 = Qiuhe1 Mod 10
Jinwei1 = 1 - Int(Qiuhe1 / 10)
Yushu1 = "" & Benwei1 & Yushu1
Next
Beichushu1 = Yushu1
Do While Left(Beichushu1, 1) = "0"
If Len(Beichushu1) > 1 Then
Beichushu1 = Mid(Beichushu1, 2, Len(Beichushu1) - 1)
Else
Beichushu1 = ""
Exit Do
End If
Loop
End If
Next
'写最终的余数
Kong1 = Kong1 - 1
If Beichushu1 = "" Then
Beichushu1 = "0"
End If
Charu1 = ""
For jj = 1 To Kong1 - Len(Beichushu1)
Charu1 = Charu1 & " "
Next
Charu1 = Charu1 & Beichushu1
Charu2 = Mid(Charu1, 1, Len3)
For jj = Len3 + 1 To Len2 + Len3 + 1
Charu2 = Charu2 & "Β" & Mid(Charu1, jj, 1)
Next
Selection.TypeParagraph
Selection.TypeText Text:=Charu2
Selection.TypeParagraph
'去除商最左侧的0
For ii = 1 To Len(Str1) - 1
If Left(Str1, 1) = "0" Then
Str1 = Right(Str1, Len(Str1) - 1)
Else
Exit For
End If
Next
'Str4 = Str1
'If Str4 <> "0" Then
'这一段预留下,可以对商为0的情况改写。
'End If
'根据小数点位置,补充商左侧的0
For ii = Len(Str1) To Len5
Str1 = "0" & Str1
Next
'补充商左侧的空格
For ii = Len(Str1) To Len2 + Len3
Str1 = " " & Str1
Next
'为商插入不占位的小数点
If Len5 > 0 Then
Str1 = Left(Str1, Len(Str1) - Len5) & "Η" & Right(Str1, Len5)
End If
'写商
Selection.Start = Kaishi
Selection.End = Kaishi
Selection.TypeText Text:=Str1
Selection.TypeParagraph
'为被除数插入不占位的小数点
If Len5 > 0 Then
Selection.EndKey Unit:=wdLine
Selection.MoveLeft Unit:=wdCharacter, Count:=2 * Len5
Selection.TypeText Text:="Η"
Selection.HomeKey Unit:=wdLine
End If
'删除被除数下面多于的一行
Selection.MoveDown Unit:=wdParagraph, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=True
Selection.Delete
'设置字体
Selection.WholeStory
Selection.Font.Name = "仿宋极简"
tuichu1:
End Sub
Sub aaTihuanF(Txt1_s As String, Txt2_s As String, Optional ByVal Num1_s As Integer)
With Selection.Find
.ClearFormatting '清除格式
.Replacement.ClearFormatting '清除格式
.MatchByte = True '区分全角和半角
.MatchWildcards = False '不使用通配符
.Wrap = wdFindStop '不从头开始查找替换
.Text = Txt1_s '被替换的文字
.Replacement.Text = Txt2_s '替换的文字
If Num1_s > 1 Then
For ii_s = 1 To Num1_s
.Execute Replace:=wdReplaceAll
Next
Else
.Execute Replace:=wdReplaceAll '替换所有
End If
End With
End Sub
word宏