求批量替换康熙部首为普通汉字的 VBA 脚本

2022-07-13 15:22:23 +08:00
 hs0000t

如题,原 Word 文件估计是哪个吃错药的 PDF 转换器搞出来的,蛋疼

附一个网上找到的对照表 https://github.com/ritajie/kangxi_i_know_you/blob/master/dict.json

754 次点击
所在节点    问与答
1 条回复
hs0000t
2023-03-15 21:53:10 +08:00
感谢 chatgpt ,帮我解决了这个近一年前的问题

```vba
Sub RestoreChineseCharacters()
'使用 WinHttp 对象下载 JSON 文件并读取内容
Dim url As String
url = "https://github.com/ritajie/kangxi_i_know_you/blob/master/dict.json?raw=true"
Dim httpRequest As Object
Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
httpRequest.Open "GET", url, False
httpRequest.send
Dim jsonFileContent As String
jsonFileContent = httpRequest.responseText

'解析 JSON 内容并保存到字典中
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim startPos As Long
Dim endPos As Long
Dim key As String
Dim value As String
startPos = InStr(jsonFileContent, Chr(34)) + 1
Do While startPos > 0
endPos = InStr(startPos + 1, jsonFileContent, Chr(34))
key = Mid(jsonFileContent, startPos, endPos - startPos)
startPos = InStr(endPos + 1, jsonFileContent, Chr(34)) + 1
endPos = InStr(startPos + 1, jsonFileContent, Chr(34))
value = Mid(jsonFileContent, startPos, endPos - startPos)
dict.Add key, value
startPos = InStr(endPos + 1, jsonFileContent, Chr(34)) + 1
Loop

'遍历 Word 文档内容并替换“康熙部首”编码
Dim doc As Document
Set doc = ActiveDocument
Dim para As Paragraph
Dim text As String
For Each para In doc.Paragraphs
text = para.Range.Text
Dim k As Variant
For Each k In dict.Keys
text = Replace(text, k, dict(k))
Next k
para.Range.Text = text
Next para
End Sub
```

这是一个专为移动设备优化的页面(即为了让你能够在 Google 搜索结果里秒开这个页面),如果你希望参与 V2EX 社区的讨论,你可以继续到 V2EX 上打开本讨论主题的完整版本。

https://www.v2ex.com/t/865924

V2EX 是创意工作者们的社区,是一个分享自己正在做的有趣事物、交流想法,可以遇见新朋友甚至新机会的地方。

V2EX is a community of developers, designers and creative people.

© 2021 V2EX