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

V2EX = way to explore

V2EX 是一个关于分享和探索的地方

现在注册

已注册用户请登录

V2EX 提问指南

这是一个创建于 862 天前的主题，其中的信息可能已经有所发展或是发生改变。

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

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

对照表

康熙部

VBA

蛋疼

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
```