请教如何通过代码实现单词音标按音节多少排序

tangqingfu

想要实现对音标音节进行排序，请教如何通过VBA代码实现单词音标所在段落（音标后面也可能会有中文意思的情况）进行排序？重音在前面的排在前面，重音在后面的排在后面。将双音节重音符号ˈ在前的段落放在前面，双音节重音符号ˈ在后（即重音符号在分割符号“•”后）的段落放在后面。
将三音节重音符号ˈ在前的段落放在前面，三音节重音符号ˈ在中（即重音符号在第1个分割符号“•”后）的段落放在其次，三音节重音符号ˈ在后（即重音符号在第2个分割符号“•”后）的段落放在最后。
四个音节，五个音节……以此类推。
感觉可以根据重音符号与分割符号“•”的位置对每种情况进行分类。

duquancai

排序不是重点，原来你也提过这个问题，我原来也说过重点在于：从文档中怎么区分开  重音、双音节重音、三音节重音？？？只要区分开来了，排序就简单了！
比如 这个是什么音节？怎么断定它归类到“三音节的”？判断的标准是什么？同为“三音节”的又如何区分前后关系？，一句话怎么区分开，这才是重点！！！

tangqingfu

duquancai 发表于 2018-4-8 13:56
排序不是重点，原来你也提过这个问题，我原来也说过重点在于：从文档中怎么区分开  重音、双音节重音、三音 ...

感谢duquancai兄的关注！
1、区分音节数量的依据是分割符（中间点），如果是单音节，则没有分割符，如果是双音节，则有一个分割符（中间点），如果是三音节，则有两个分割符（中间点），如果是四音节，则有三个分割符（中间点）。
2、判断同类音节的依据：
单音节：无重音符号，也无分割符号；
双音节：有重音符号，如果重音符号（即音标上方的一小竖符号）在第一个分割符前，则属于重音在前（第一个音节）；如果重音符号（即音标上方的一小竖符号）在第一个分割符后，则属于重音在后（重音在第二个音节）；
三音节：有重音符号，如果重音符号（即音标上方的一小竖符号）在第一个分割符前，则属于重音在前（第一个音节）；如果重音符号（即音标上方的一小竖符号）在第二个分割符前，则属于重音在中（重音在第二个音节）；如果重音符号（即音标上方的一小竖符号）在第二个分割符后，则属于重音在后（重音在第三个音节）；
四音节：有重音符号，如果重音符号（即音标上方的一小竖符号）在第一个分割符前，则属于重音在前（第一个音节）；如果重音符号（即音标上方的一小竖符号）在第二个分割符前，则属于重音在第二个音节）；如果重音符号（即音标上方的一小竖符号）在第三个分割符前，则属于重音在第三个音节；如果重音符号（即音标上方的一小竖符号）在第三个分割符后，则属于重音在第四个音节；
以此类推
各段落按上述方式进行排序，烦请duquancai兄帮帮忙。

tangqingfu

duquancai 发表于 2018-4-8 13:56
排序不是重点，原来你也提过这个问题，我原来也说过重点在于：从文档中怎么区分开  重音、双音节重音、三音 ...

上图，能否请杜老师帮忙解决？

tangqingfu

duquancai 发表于 2018-4-8 13:56
排序不是重点，原来你也提过这个问题，我原来也说过重点在于：从文档中怎么区分开  重音、双音节重音、三音 ...

期待杜老师帮忙解决……

duquancai

tangqingfu 发表于 2018-4-14 14:13
期待杜老师帮忙解决……

不是不帮你，可能花时间非常多，代码量很大！应该很少会有人帮你写这个代码，还是那句话：花费时间太多！

tangqingfu

duquancai 发表于 2018-4-14 14:31
不是不帮你，可能花时间非常多，代码量很大！应该很少会有人帮你写这个代码，还是那句话：花费时间太多！

好像是不好解决。
谢谢杜老师！如果有时间，还请杜老师能帮帮忙。

413191246se

唐兄：我建议你提供更具体的带有重音符号的模拟附件，并说明要达成的目标（杜先生 没时间，我有时间，看看能否帮到你，但不保证能成功）。刚才我试着做了一个代码，每个段落包括多少个"a"，再排序，就是循环遍历段落即可（目前我还找不到那个分隔符·大圆点，如果你能替换，最好把它替换成小撇儿'）。

duquancai

tangqingfu 发表于 2018-4-14 15:09
好像是不好解决。
谢谢杜老师！如果有时间，还请杜老师能帮帮忙。

承蒙多次邀请！亦或今天周末有点时间，写了一下代码，也没时间逐字逐句斟酌！仅供一个思路！
目前代码：对“单音节、双音节、三音节、四音节”进行了排序！更多的“五音节、六音节......”,可扩展。

1. Sub test()
   
2.     Dim S As Range, p As Paragraph, nDoc As Document
   
3.     Dim reg As Object, d As Object, mt, sr$, k, mySortKey$(), myK
   
4.     Set S = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
   
5.     If S = ActiveDocument.Content Then
   
6.         AB = MsgBox("要进行全文排序吗？", vbYesNoCancel + vbQuestion, "全文处理判断")
   
7.         If AB <> vbYes Then Exit Sub
   
8.     End If
   
9.     Set reg = CreateObject("VBScript.Regexp")
   
10.     reg.Global = True: reg.Pattern = "\u2022\u02c8?"
    
11.     Set d = CreateObject("Scripting.Dictionary")
    
12.     For Each p In S.Paragraphs
    
13.         n = n + 1
    
14.         If f(p.Range.Text, "/[^/一-﨩]+/") Then
    
15.             Select Case reg.Execute(p.Range.Text).Count
    
16.             Case Is = 0 '单音节
    
17.                 d("A") = d("A") & "," & n
    
18.             Case Is = 1 '双音节
    
19.                 sr = reg.Execute(p.Range.Text)(0).Value
    
20.                 If Not f(sr, "\u02c8") Then
    
21.                     d("B") = d("B") & "," & n
    
22.                 Else
    
23.                     d("BA") = d("BA") & "," & n
    
24.                 End If
    
25.             Case Is = 2 '三音节
    
26.                 Set mt = reg.Execute(p.Range.Text)
    
27.                 For i = 1 To mt.Count
    
28.                     If f(mt(i - 1).Value, "\u02c8") Then Exit For
    
29.                 Next
    
30.                 Select Case i
    
31.                 Case Is = 3
    
32.                     d("C") = d("C") & "," & n
    
33.                 Case Is = 1
    
34.                     d("CA") = d("CA") & "," & n
    
35.                 Case Is = 2
    
36.                     d("CB") = d("CB") & "," & n
    
37.                 End Select
    
38.             Case Is = 3 '四音节
    
39.                 Set mt = reg.Execute(p.Range.Text)
    
40.                 For i = 1 To mt.Count
    
41.                     If f(mt(i - 1).Value, "\u02c8") Then Exit For
    
42.                 Next
    
43.                 Select Case i
    
44.                 Case Is = 4
    
45.                     d("D") = d("D") & "," & n
    
46.                 Case Is = 1
    
47.                     d("DA") = d("DA") & "," & n
    
48.                 Case Is = 2
    
49.                     d("DB") = d("DB") & "," & n
    
50.                 Case Is = 3
    
51.                     d("DC") = d("DC") & "," & n
    
52.                 End Select
    
53.             End Select
    
54.         End If
    
55.     Next
    
56.     k = d.keys: ReDim mySortKey(1 To d.Count)
    
57.     For i = 0 To UBound(k)
    
58.         mySortKey(i + 1) = k(i)
    
59.     Next
    
60.     WordBasic.SortArray mySortKey()
    
61.     Set nDoc = Documents.Add
    
62.     For Each myK In mySortKey
    
63.         For Each t In Split(Mid(d(myK), 2), ",")
    
64.             With nDoc.Bookmarks("\EndOfDoc").Range
    
65.                 .FormattedText = S.Paragraphs(t).Range.FormattedText
    
66.             End With
    
67.         Next
    
68.     Next
    
69. End Sub
    
70. Function f(ByVal sr As String, ByVal r As String) As Boolean
    
71.     Dim reg As Object
    
72.     Set reg = CreateObject("VBScript.Regexp")
    
73.     reg.Pattern = r
    
74.     If reg.test(sr) Then f = True
    
75. End Function

复制代码

413191246se

杜先生/老师 出手了，太好了！就是又是正则，又是书签，实在看不懂。