如何用递归将嵌套表中数字换成分数形式？

dzweather

如图，左为最终效果，右为要转换的嵌套表。
特征： 1、嵌套表
            2、表为二行一列。
     （注意：也可能分子中也出现分数情况，即繁分数）
如何用递归方法将其转换成繁分数？请高手写一下代码。

自己编写了一个，没通过。。。。。参数传不过来，查不到原因。
下面是我的错误代码

1. Sub a() '主函数
   
2.     Dim i As Integer, hcount As Integer
   
3.     Dim mytable As Table
   
4.    
   
5.     hcount = Me.Tables.Count
   
6.     For i = hcount To 1 Step -1
   
7.         Set mytable = Me.Tables(i)
   
8.         If mytable.Rows.Count = 2 And mytable.Columns.Count = 1 Then '繁分数递归
   
9.             complex (mytable)
   
10.         End If
    
11.     Next i
    
12. End Sub
    
13. 
    
14. Sub complex(ByRef myT As Table)  '繁分数递归
    
15.     If myT.Cell(1, 1).Tables.Count = 0 Then '分子递归
    
16.         zi = Replace(myT.Cell(1, 1).Range.Text, Chr(13) & Chr(7), "") '分子去掉回车
    
17.     Else
    
18.         For Each tzi In myT.Cell(1, 1).Tables
    
19.             complex (tzi)
    
20.         Next tzi
    
21.     End If
    
22.     If myT.Cell(2, 1).Tables.Count = 0 Then '分母递归
    
23.         mu = Replace(myT.Cell(2, 1).Range.Text, Chr(13) & Chr(7), "") '分母去掉回车
    
24.     Else
    
25.         For Each tmu In myT.Cell(2, 1).Tables
    
26.             complex (tmu)
    
27.         Next tmu
    
28.     End If
    
29.    
    
30.     myT.Select
    
31.     Selection.Tables(1).Delete   '删除该表格
    
32.     Set myfield = aDoc.Fields.Add(Range:=Selection.Range, Type:=wdFieldEmpty) '增加一个空的新域
    
33.     myfield.Code.Text = "EQ \F(" + zi + "," + mu + ")" '填写域代码
    
34.    
    
35. End Sub

复制代码

繁分数.rar (10.52 KB, 下载次数: 15)

2015-1-5 15:06 上传

点击文件名下载附件
word繁分数

dzweather

搞了N久，问了N个人。
终于搞出来了。
原因：
1、调用时不要加（） 。如：complex (tmu) 错误
2、嵌套表中的表前表后回车要处理好，直接删除是删除不了的。（先删除表，再删除回车）
3、嵌套域不是简单的嵌套，内嵌中并没有eq，所以用符号表示后，递归出来后，再化公式。

代码如下：

1. Sub a() '主函数
   
2.     Dim i As Integer, hcount As Integer
   
3.     Dim myTable As Table
   
4.    
   
5.     hcount = Me.Tables.Count
   
6.     For i = hcount To 1 Step -1
   
7.         Set myTable = Me.Tables(i)
   
8.         If myTable.Rows.Count = 2 And myTable.Columns.Count = 1 Then '繁分数递归
   
9.             complex myTable
   
10.             Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="eq " & Selection.Range.Text, PreserveFormatting:=False    '增加一个新域
    
11.         End If
    
12.     Next i
    
13. End Sub
    
14. 
    
15. Sub complex(myT As Table)  '繁分数递归
    
16.     Dim zi As String, mu As String
    
17.     myT.Cell(1, 1).Range.Find.Execute FindText:="([^13^11]){1,9}", MatchWildcards:=True, replacewith:="", Replace:=wdReplaceAll
    
18.     myT.Cell(2, 1).Range.Find.Execute FindText:="([^13^11]){1,9}", MatchWildcards:=True, replacewith:="", Replace:=wdReplaceAll
    
19. 
    
20.     If myT.Cell(1, 1).Tables.Count = 0 Then '分子递归
    
21.         zi = "\f(" & Replace(myT.Cell(1, 1).Range.Text, Chr(13) & Chr(7), "") & "," '分子去掉回车
    
22.     Else
    
23.         Dim tzi As Table
    
24.         
    
25.         For Each tzi In myT.Cell(1, 1).Tables
    
26.             complex tzi
    
27.         Next tzi
    
28.         zi = "\f(" & Replace(myT.Cell(1, 1).Range.Text, Chr(13) & Chr(7), "") & ","
    
29.     End If
    
30.     If myT.Cell(2, 1).Tables.Count = 0 Then '分母递归
    
31.         mu = Replace(myT.Cell(2, 1).Range.Text, Chr(13) & Chr(7), "") & ")" '分母去掉回车
    
32.     Else
    
33.         Dim tmu As Table
    
34.         
    
35.         For Each tmu In myT.Cell(2, 1).Tables
    
36.             complex tmu
    
37.         Next tmu
    
38. 
    
39.         mu = Replace(myT.Cell(2, 1).Range.Text, Chr(13) & Chr(7), "") & ")"
    
40.     End If
    
41.    
    
42.     myT.Select
    
43.     Selection.Tables(1).Delete   '删除该表格
    
44.     Selection.MoveLeft
    
45.     Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    
46.     If Selection.Range.Text = Chr(13) Then
    
47.         Selection.Delete
    
48.     End If
    
49.     Selection.InsertAfter Text:=zi & mu
    
50.     'Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="eq " & zi & mu, PreserveFormatting:=False   '增加一个新域
    
51. 
    
52. End Sub

复制代码

周星骋

果然是高人。

loquat

用域嵌套也比较方便。。。

zhanglei1371

这个能用于更复杂些的情况：

1. Dim s
   
2. Sub sdf()
   
3. s = ""
   
4. Dim ta As Table, ro As Row
   
5. Dim ta1 As Table
   
6.     Set ta = Me.Tables(1)
   
7.     处理 ta, s
   
8.     s = "eq " + Replace(s, Chr(13), "")
   
9.     ta.Delete
   
10. Selection.InsertAfter s
    
11. Application.Run "insertfieldchars"
    
12. Selection.Fields.Update
    
13. End Sub
    
14. Function 处理(ta As Table, s)
    
15.     For i = ta.Rows.Count To 1 Step -1
    
16.         If ta.Rows(i).Cells(1).Tables.Count > 0 Then
    
17.             For j = 1 To ta.Rows(i).Cells(1).Tables.Count
    
18.                 处理内表 ta.Rows(i).Cells(1).Tables(1)
    
19.             Next
    
20.             i = i + 1
    
21.         Else
    
22.                 m = Replace(ta.Rows(i).Cells(1).Range.Text, Chr(13) & Chr(7), "")
    
23.                 If s = "" Then
    
24.                     s = m
    
25.                 Else
    
26.                     s = "\f(" + m + "," + s + ")"
    
27.                 End If
    
28.             End If
    
29.         Next
    
30.     End Function
    
31. Function 处理内表(ta As Table)
    
32.     处理 ta, s
    
33.     ta.Select
    
34.     ta.Delete
    
35.     Selection.TypeText s
    
36.     s = ""
    
37. End Function

复制代码

→→→→→