【Word宏】根据除法的横式写竖式

此例的功能是选中一个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宏