|
|
楼主 |
发表于 2021-4-1 07:31
|
显示全部楼层
本帖最后由 相见是缘8 于 2021-4-3 06:21 编辑
- Sub RepXml(FindStr() As String, RepStr() As String)
- '替换过程开始前，需要根据替换关键词排序：被包含的放在后面，替换的关键词位置相应变动！请自己完善
- Dim i As Long
- Dim j As Long
- Dim p As Long
- Dim repNum As Long
- Dim XmlPart() As String
- Dim ParaPart() As String
- Dim ParaNum As Long
- Dim ParaStr As String
- Dim NewStr As String
- Dim txtPart() As String
- Dim PartNum As Long
- Dim StartIndex As Long
- Dim repLen As Long
- Dim DblZeroChar As String
- Dim ZeroChar As String
- ZeroChar = ChrW$(0)
- DblZeroChar = ZeroChar & ZeroChar
- repNum = UBound(FindStr)
- ParaPart = Split(ActiveDocument.Range.XML, "</w:p>")
- ParaNum = UBound(ParaPart) - 1
- For p = 0 To ParaNum
- XmlPart = Split(ParaPart(p), "</w:t>")
- If UBound(XmlPart) > 0 Then
- PartNum = UBound(XmlPart) - 1
- ReDim txtPart(PartNum) As String
- For i = 0 To PartNum
- '替换过程中特殊字符，主要是<>&,还有些其它字符，需要处理：先替换为正常的;，后替换回来"<", "<"；">", ">"；"&", "&，请自己完善
- txtPart(i) = Right$(XmlPart(i), Len(XmlPart(i)) - InStrRev(XmlPart(i), ">"))
- Next
- ParaStr = Join(txtPart, "")
- For i = 0 To repNum
- If InStr(ParaStr, FindStr(i)) > 0 Then
- repLen = Len(FindStr(i))
- NewStr = Replace$(ParaStr, FindStr(i), String$(repLen, ZeroChar))
- StartIndex = 1
- For j = 0 To PartNum
- txtPart(j) = Mid$(NewStr, StartIndex, Len(txtPart(j)))
- StartIndex = StartIndex + Len(txtPart(j))
- Do While InStr(txtPart(j), DblZeroChar)
- txtPart(j) = Replace$(txtPart(j), DblZeroChar, ZeroChar)
- Loop
- Next
- txtPart(0) = Replace$(txtPart(0), ZeroChar, RepStr(i))
- For j = 1 To PartNum
- If Left$(txtPart(j), 1) = ZeroChar And Right$(txtPart(j - 1), 1) = ZeroChar Then
- txtPart(j) = Right$(txtPart(j), Len(txtPart(j)) - 1)
- End If
- txtPart(j) = Replace$(txtPart(j), ZeroChar, RepStr(i))
- Next
- ParaStr = Join(txtPart, "")
- End If
- Next
- For i = 0 To PartNum
- If Left$(txtPart(i), 1) = " " Then
- XmlPart(i) = Left$(XmlPart(i), InStrRev(XmlPart(i), "><")) & "<w:t xml:space=""preserve"">" & txtPart(i)
- Else
- XmlPart(i) = Left$(XmlPart(i), InStrRev(XmlPart(i), ">")) & txtPart(i)
- End If
- Next
- ParaPart(p) = Join(XmlPart, "</w:t>")
- End If
- Next
- ActiveDocument.Range.InsertXML Join(ParaPart, "</w:p>")
- End Sub
- Sub testRep()
- Dim FindStr() As String
- Dim RepStr() As String
- FindStr = Split("大枣_|_亦_|_盖_|_钱，_|_钱半，_|_克，_|_枚，_|_两，_|_两半，_|_》日_|_曰._|_曰，_|_曰,_|_曰；_|_曰∶_|_曰:_|_曰︰_|_曰。_|_曰：_|_曰_|_∶_|_%_|_-_|_~_|_(_|_)_|_。）_|_ ）_|_（", "_|_")
- RepStr = Split("红枣_|_也_|_凡_|_钱、_|_钱半、_|_克、_|_枚、_|_两、_|_两半、_|_》曰_|_曰_|_曰_|_曰_|_曰_|_曰_|_曰_|_曰_|_曰_|_曰_|_曰：_|_：_|_％_|_～_|_～_|_（_|_）_|_）。_|_）_|_（", "_|_")
- RepXml FindStr, RepStr
- End Sub
cuteword 发表于 2021-3-31 21:12
估计楼主没有我的联系方式，因为没有时间完善代码，就先把代码贴上来，里面标注了存在的问题。代码比较简单 ...
龚老师好！
万分感谢你抽时间写的代码！代码替换速度真是飞快，十几秒就搞定！我没有你的联系方式，也没有编程基础，只会一点手动替换，你的代码和论坛上老师的代码绝大多数看不懂，只能靠网上搜，但很少搜到带中文注释的，再一个是迫于生活的压力，很难静下心来持久的学这个东西，所以总是门外汉，遇到问题只能一次又一次的向老师们求助！
|
|
楼主: 相见是缘8
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2021-3-31 21:12
