修改次序混乱不同的数量单位和重复的数量单位

相见是缘8 · 发表于 2022-8-18 10:52

本帖最后由相见是缘8 于 2022-8-19 05:19 编辑

老师好！

求老师们帮忙，谢谢！详见附件！

相见是缘8 · 发表于 2022-8-23 10:36

本帖最后由相见是缘8 于 2022-8-24 10:29 编辑

奇怪了，这么多天都不见有老师回复，是难度太大，还是会的老师，没有上线呢？

相见是缘8 · 发表于 2022-8-27 09:28

继续向老师们求助！

sylun · 发表于 2022-8-27 18:15

是较复杂，感觉文本不是很规范，特别是标点符号与断句。可试试如下代码，有些段落未能匹配。已有简单说明，可自行修改代码以尽量适应实际文档

Private num(0 To 99) As String
Sub test()
Dim i%, j%, k%, n1%, n2%, r%, s%
Dim data$, code$, info$(), info1$(), info2$(), data2$()
Dim RegExp As Object
Dim Match As Object
Dim RegExp2 As Object
Dim Match2 As Object
data = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content.Text, Selection.Text)
code = "斤两钱分厘枚粒片" '数量单位据此先后排序
Set RegExp = CreateObject("VBScript.RegExp")
Set RegExp2 = CreateObject("VBScript.RegExp")
With RegExp
.Global = True
.Pattern = "[用方]：([^。：]+。)" '特征文本：用字加冒号开头，同一段落至句号结束
For Each Match In .Execute(data)
ReDim info(Len(code))
With RegExp2
.Global = True
For i = 1 To Len(code)
'提取用于排序的文本特征，暂定数量及单位后须跟顿号或句号
.Pattern = "([^、。]+?([十九八七六五四三二一半]+)" & Mid(code, i, 1) & ")[、。]"
If .test(Match.submatches(0)) = True Then
For Each Match2 In .Execute(Match.submatches(0))
info(i - 1) = info(i - 1) & Match2.Value
ReDim Preserve info1(1, n1)
info1(0, n1) = Match2.submatches(0)
info1(1, n1) = Match2.submatches(1)
n1 = n1 + 1
Next
For k = 99 To 0 Step -1
For j = 0 To UBound(info1, 2)
If info1(1, j) = num(k) Then
ReDim Preserve info2(n2)
info2(n2) = info1(0, j)
n2 = n2 + 1
End If
Next
Next
ReDim Preserve data2(r)
data2(r) = data2(r) & Join(info2, "、")
r = r + 1
Erase info1
Erase info2
n1 = 0
n2 = 0
End If
Next
End With
With Match
data = Left(data, .firstindex + 2) & Join(data2, "、") & Mid(data, .firstindex + .Length)
End With
Erase info
Erase data2
r = 0
Next
For i = 1 To Len(code) '用于处理判断为相同数量及单位的药
RegExp2.Pattern = "([^、。]+?)各?([十九八七六五四三二一半]+" & Mid(code, i, 1) & ")[、。]([^、。]+?)\2([、。])"
If InStr(data, Mid(code, i, 1)) Then
Do While RegExp2.test(data) = True
data = RegExp2.Replace(data, "$1，$3各$2$4")
s = s + 1
Loop
End If
Next
Documents.Add(ActiveDocument.FullName).Content.Text = data
End With
End Sub
Sub NumToCnNum()
'生成百位内汉字小写数字
Const a As String = "一二三四五六七八九"
Dim i%, n%
For i = 1 To 99
Select Case i
Case Is >= 20
If i Mod 10 > 0 Then
num(i) = Mid(a, Int(i / 10), 1) & "十" & Mid(a, i Mod 10, 1)
Else
num(i) = Mid(a, Int(i / 10), 1) & "十"
End If
Case Is > 10
num(i) = "十" & Mid(a, Int(i Mod 10), 1)
Case Is < 10
num(i) = Mid(a, i, 1)
Case Else
num(i) = "十"
End Select
Next
num(0) = "半"
End Sub

复制代码

wdpfox · 发表于 2022-8-27 22:19

sylun 发表于 2022-8-27 18:15
是较复杂，感觉文本不是很规范，特别是标点符号与断句。可试试如下代码，有些段落未能匹配。已有简单说明， ...

高深强大，虽然看不懂

413191246se · 发表于 2022-8-28 10:00

sylun 老师的代码，我也看不懂，我只能叹服老师四个字：“叹为观止！”！老师辛苦了！

相见是缘8 · 发表于 2022-8-28 10:30

sylun 发表于 2022-8-27 18:15
是较复杂，感觉文本不是很规范，特别是标点符号与断句。可试试如下代码，有些段落未能匹配。已有简单说明， ...

终于等到大神出手相助！非常感谢sylun老师！

可不知啥原因，代码在我这运行出错！

相见是缘8 · 发表于 2022-8-28 10:33

感谢诸位老师捧场！谢谢！

413191246se · 发表于 2022-8-28 12:41

本帖最后由 413191246se 于 2022-8-28 18:33 编辑

* 相见，代码复制到 VBE 中，运行正常，但处理结果不正确（如果是 2019，需要复制到空白文档后，再全选，剪切，复制到 VBE 中运行）。

* sylun 老师：我帮相见也测试了一下，实话实说，错误不少。单位大小关系不正确（如：三两在四两前面等）。——我粗浅地提出一个建议：能否把处理结果放在每一段的后面，以与所处理的前一段对照修改可好。

* 万望老师好好休息，别累坏了。不愿意做就不做，有兴趣时再做（这一夏天，我也是断断续续地想修改自动排版宏代码，但因为天热、身体不好、水平不高，所以，每天都是做得不多，还经常放弃、反复），人毕竟不是机器人，有时挺累（我发现，出成果要在午前，午后就困，晚上更是）。

相见是缘8 · 发表于 2022-8-28 17:35

本帖最后由相见是缘8 于 2022-8-28 18:09 编辑

413191246se 发表于 2022-8-28 12:41
* 相见，代码复制到 VBE 中，运行正常，但处理结果不正确（如果是 2019，需要复制到空白文档后，再全选，剪 ...

413191246se老师好！
你运行也正常？我用的还是公司的电脑，系统是XP，用的 Word是2003版的，测试几遍都不成！

		自动登录	找回密码
密码			免费注册

[求助] 修改次序混乱不同的数量单位和重复的数量单位

评分