讀《史記三家注》；整理《中國哲學書電子化計劃》維基文本與書影圖檔對應之Word VBA程式碼
孫守真按：整理《中國哲學書電子化計劃》所蒐集之本書維基文本，以對應於釋出版權之書影圖版，方發現文本疵謬甚多，多為簡化字反正後之誤，然亦不少輸入之誤，或電腦系統造字之訛（多作「?」及亂碼，導致文本錯亂：如「參朝?」，應乃「倮參朝請」之「倮」造字造成亂碼；又有因此掉字者，如「龍𬱃侯」訛為「龍侯」），或不詳原因之錯處。姑誌於此以俟來者。
厮冢；綫𥵡；𠑥箣；邪衺；眥眦；鵔鸃→鵕䴊；矗𨙻；概槪槩；管筦；底厎；賖畼；𧵔鶮；脚㿅；嫻嫺；閒閑；蒙矇；蓄稸；坑阬；折摺；犨犫；骯肮；佣傭；鞁韝；婿壻；罌甖；氓甿；甕瓮；斫斲；卮巵；曲麴；克剋；俞兪；喧諠；戮勠；複→復；複→覆；捍→扞；托→託；症→癥；御→禦；棰→箠；妒→妬；疏→疎；灶→竈；頹→穨；奔→犇；殭→僵；慷→忼；誇→夸；淆→殽；籲→吁；乾→干；干→幹；旗→旂；槨→椁；唇→脣；圭→珪；綿→緜；污→汙；鋤→鉏；蕓→芸；雁→鴈；暖→煖；蒞→莅；塹→壍；系→係；系→繫；窺→闚；簷→檐；慚→慙；採→采；喑→瘖；糠→穅；雜→襍；沓→遝；於→于；挽→輓；歡→懽；歡→讙；嘩→譁；餉→饟；偷→媮（婾）；愆→𠎝；秘→祕；厘→釐；勛→勳；敦→惇；須→鬚；制→製；厄→戹；扼→㧖；扼→搤；灑→洒；愍→湣；鱉→鼈；雕→彫；粗→麤；迭→疊；髹→髤；冉→冄；修→脩→；潔→絜；濕→溼；累→纍；褒→襃；啖→啗；啖→嚪；機→机；姜→薑；棋→棊；鬱→郁；楠→枏；岳→嶽；鬥→斗；鬥→鬭；斗→鬭；乃→迺；核→覈；向→嚮；災→菑；虻→蝱；虱→蝨；雲→云；巨→鉅；叡→睿；里→裏；裏→里；樸→朴；僕→仆；廁→筴；後→后；后→後；蘋→苹；床→牀；寧→甯；皂→皁；蟻→螘；蚓→螾；吟→唫；吊→弔；強→彊；既→卽；罪→辠；稿→稾；歷→曆；強→强；扼→搤；尸→屍；穀→谷；谷→穀；回→迴；睹→覩；雷→靁；嚙→齧；昏→昬；嘆→歎；憖→憗；並→竝；並→幷；岩→巖；劃→畫；塚→冢；個→箇；奸→姦；洩→泄；井→幷；泛→汎；泛→氾；溪→谿；針→鍼；闢→辟；遍→徧；棄→弃；幾→几；發→髮；期→朞；准→準；游→遊；詬→訽；台→臺；局→跼；伙→夥；餘→余；余→餘；征→徵；擲→擿；確→确；築→筑；盤→槃；合→郃；跡→迹；範→范；慄→栗；冤→寃；輝→煇；晁→鼂；膝→䣛；
q遌；
還有「（）」誤作「〔〕」者，如「南〔郡〕，迎楚河上」，原書影乃「南（郡），迎楚河上」；有無（）而誤加者，如「（漢）乃使人賜彭越將軍印」。又有漏掉注腳標號者，如「舉以為收孥。」下之注七號。而「九州」都誤成「九州島」，殆係輸入法太過聰明自動之故。不一而足。
從2858頁起，20210920:0817之後，改用臺師大附中同學吳恆昇先生《中華文化網》所錄中研院《瀚典》初本，雖或仍未精，然至少免有簡化字轉換訛窘或造字亂碼之困擾，原文字檔棄置。根據初作比對，格式完全一樣！根本就是從這裡出來的，再轉簡化字，再又反正，造成之紊亂。悔當初沒想到用此本也。阿彌陀佛。佛弟子孫守真任真甫謹識於2021年9月20日
以下錄尚須校訂以忠於原本之字：
棄→弃；蹴→蹙；阨→阸；雜→襍；沸→㵒；慚→慙；褒→襃；跡迹；衝𧘂；奔犇；鴐𪀁；鵝䳘；鵁𪁉；鶄𪂴；蒞莅；敕勑；虯虬；峻陖；笄筓；貌皃；陀陁；巀嶻；稿稾；檗檘；蹶蹷；姌㚩；塹𡐛；刪删；雷靁；繈繦；愆𠎝；冞罙；協叶；遍徧；睹覩；孽孼；妒妬；灶竈；強强；騮駵；棋棊；奈柰；詬訽；蜂蠭；鱉鼈；罪辠；刊栞；啟啓；槁槀；訛譌；榆楡；概槪槩；衽袵；俞兪；|
「犁→犂」（據《漢籍電子文獻資料庫》唯〈伍子胥列傳〉與〈酷吏列傳〉有「犁」者。）
「鬥→鬭」則決無作「鬥」者，而《漢籍電子文獻資料庫》則作「鬬」，並非原文也。「綿→緜」，作「綿」者，亦唯〈貨殖列傳〉有一個。類似者尚有：|
冉→冄；慚→慙|
《瀚典》自行造字部分（會造成ctext維基亂碼成半形問號「?」）：|
𧃍→䝠；𣺋→𨎥；犨→𧁱；茘→𣹰；𦹄→䡺；芳→𠫲；嚉→𭽀；俹→鱅；㷓䳒；𧤤𨙻；菓傫；蓤𢈻；𦩒䱍；駠恡；𣵾䲛；橓䴋；𤪕𪆫；䑺𪇅；舩䳄；笧袿；墰䴉；𡡀訽；𦛨𡾋；聡𡾊；𣷣䁆；鞉瞹；𢜔𧮰；耯𧤗；耨櫩；𣝦㮈；翺𣗶；𠻘蹹；縧袣；㴓傉；繮䧢；緥𤟭；妤麪；醶朌；𦀩䆃；焵𦜕；嗬㭊；灜㞶；𠹹悤；蟮誷；𤳉㟭；遤醻；賛𣻐；𧶏䳜；煼䫇；㻐檋；𨬯蹏；丷㜪𡣎；貛㯉；𧵔鶮；衏鸖；蹴䱷；氺湌；斋麄；㑾䝁；駦裦；𥯤𦐊；瓀傊；丯樶；𡖂㘰；𨘻䲕；𨘥䱐；枿俆；𠺌䣄；|
至若「眾」作「衆」，「并」作「幷」，「衛」作「衞」等等，乃所取字樣不同，可統改置換者，便不必一一核校。
今終於完成了「2021/9/30 12:01 AM」適於49足歲生日過也。
所見《瀚典》原本洎今日《漢籍電子文獻資料庫》之訛誤，略具于是。惜之前未一一登錄（起碼不下數十條），但線上用其「錯誤通報」機制校訂爾。但願執事者莫怠忽焉可爾。感恩感恩 南無阿彌陀佛
以下程式碼跑出來的文本，要再以手段對照圖檔分行、空格才行。
Sub 史記三家注()
'從2858頁起，20210920:0817之後，改用臺師大附中同學吳恆昇先生《中華文化網》所錄中研院《瀚典》初本，雖或仍未精，然至少免有簡化字轉換訛窘或造字亂碼之困擾，原文字檔棄置。根據初作比對，格式完全一樣！根本就是從這裡出來的，再轉簡化字，再又反正，造成之紊亂。悔當初沒想到用此本也。阿彌陀佛。佛弟子孫守真任真甫謹識於2021年9月20日
Dim d As Document, a, i, p As Paragraph, px As String, rng As Range, e As Long, pRng As Range, pa
'Const corTxt As String = "＝詳點校本校勘記＝"'該網站圖文對照排版功能未能配合，故今不採用。其格式只對文本版有效。https://ctext.org/instructions/wiki-formatting/zh
'a = Array(" ", "", " ",""," ", ChrW(-9217) & ChrW(-8195), "^p", "<p>^p",
'a = Array(" ", "", " ", "", "^p^p", "<p>^p" & ChrW(-9217) & ChrW(-8195) & ChrW(-9217) & ChrW(-8195),
a = Array(" ", "", "^p", "^p^p", "^p^p^p", "^p^p", "「^p^p", "「", "『^p^p", "『", "〔^p^p", "〔", "（^p^p", "（", _
"^p^p", "<p>^p" & ChrW(-9217) & ChrW(-8195) & ChrW(-9217) & ChrW(-8195), _
"^p" & ChrW(-9217) & ChrW(-8195) & ChrW(-9217) & ChrW(-8195) & "〔", _
"^p{{" & ChrW(-9217) & ChrW(-8195) & "{{{〈", _
"「<p>^p" & ChrW(-9217) & ChrW(-8195) & ChrW(-9217) & ChrW(-8195), "「", _
"〔<p>^p" & ChrW(-9217) & ChrW(-8195) & ChrW(-9217) & ChrW(-8195), "〔", _
"『<p>^p" & ChrW(-9217) & ChrW(-8195) & ChrW(-9217) & ChrW(-8195), "『", _
"（<p>^p" & ChrW(-9217) & ChrW(-8195) & ChrW(-9217) & ChrW(-8195), "（", _
"集解", "《集解》：", "索隱", "《索隱》：", "【《索隱》：述贊】", "【《索隱》述贊】：", "正義", "《正義》：", _
"九州島", "九州", "齊愍", "齊湣", "愍王", "湣王", "安厘王", "安釐王", _
"塚", "冢", "慚", ChrW(24921), "啟", ChrW(21843), _
ChrW(-30641), ChrW(-25066), _
"群", ChrW(32675), "即", ChrW(21373), "眾", ChrW(-30650), _
"既", ChrW(26083), "概", ChrW(27114), "溉", ChrW(28433), _
"衛", ChrW(-30626), _
"真", ChrW(30494), "填", ChrW(22625), "清", ChrW(28152), "青", ChrW(-26799), "教", ChrW(25934), _
"鄉", ChrW(-28395), "鎮", ChrW(-27731), "慎", ChrW(24892), _
"并", ChrW(24183), "屏", ChrW(23643), "荊", ChrW(-31930), "邢", ChrW(-28471), "笄", ChrW(31571), _
"犁", ChrW(29314), "鬥", ChrW(-25811), "綿", ChrW(32220), _
"冉", ChrW(20868), "腳", ChrW(-32486), _
ChrW(25995), ChrW(-24956))
Set d = Documents.Add()
d.Range.PasteAndFormat wdFormatPlainText
d.Range.text = VBA.Replace(d.Range.text, " ", "")
For i = 0 To UBound(a) - 1
If a(i) = "^p^p^p" Then
px = d.Range.text
Do While InStr(px, Chr(13) & Chr(13) & Chr(13))
px = Replace(px, Chr(13) & Chr(13) & Chr(13), Chr(13) & Chr(13))
Loop
d.Range.text = px
'Set rng = d.Range
' Do While rng.Find.Execute(a(i), , , , , , True, wdFindContinue, , a(i + 1), wdReplaceAll)
' If rng.End = d.Range.End Then Exit Do
' Loop
Else
d.Range.Find.Execute a(i), , , , , , True, wdFindContinue, , a(i + 1), wdReplaceAll
End If
i = i + 1
Next i
文字處理.書名號篇名號標注
Set rng = Selection.Range
For Each p In d.Paragraphs
px = p.Range.text
If Left(px, 7) = "{{" & ChrW(-9217) & ChrW(-8195) & "{{{" Then '注腳段落
e = p.Range.Characters(1).End
rng.SetRange e, e
rng.MoveEndUntil "〕"
If rng.Next.Next = " " Then rng.Next.Next.Delete
If InStr(p.Range.text, " ") Then
For Each pa In p.Range.Characters
If pa = " " Then
pa.text = ChrW(-9217) & ChrW(-8195)
End If
Next
' p.Range.text = VBA.Replace(p.Range.text, " ", ChrW(-9217) & ChrW(-8195))
' 'replace the text of paragraph the paragraph will be move to next one
' Set p = p.Previous
' e = p.Range.Characters(1).End
' rng.SetRange e, e
' rng.MoveEndUntil "〕"
End If
'rng.Select
rng.Collapse wdCollapseEnd
rng.Select
Selection.MoveRight wdCharacter, 1, wdExtend
Selection.TypeText "〉}}}" '將注腳編號〔一〕的右邊〕改成}}}
px = p.Range.text
If InStr(Right(px, 4), "<p>") Then
e = p.Range.Characters(p.Range.Characters.Count - 4).End
Else
e = p.Range.Characters(p.Range.Characters.Count - 1).End
End If
rng.SetRange e, e
rng.InsertAfter "}}"
Else '正文段落
e = p.Range.Characters(1).start
Set pRng = p.Range
Do While InStr(pRng.text, "〔")
rng.SetRange e, e
rng.MoveEndUntil "〔"
If rng.Characters(rng.Characters.Count) <> "）" Then ' if not correction
rng.Collapse wdCollapseEnd
rng.move , 1
rng.MoveEnd wdCharacter, 1
If rng.text Like "[一二三四五六七八九]" Then ' is footnote No.
e = rng.start
'rng.Collapse wdCollapseEnd
rng.SetRange e - 1, e
rng.text = " {{{〈"
rng.MoveEndUntil "〕"
rng.Collapse wdCollapseEnd
rng.MoveEnd wdCharacter, 1
rng.text = "〉}}}"
Else 'is correction to insert words
' rng.MoveEndUntil "〕"
' rng.SetRange rng.End + 2, rng.End + 2
' rng.InsertAfter corTxt
End If
e = rng.End
Else 'is correction
' If rng.Characters(rng.Characters.Count).Next = "〔" Then ' delete and insert words
' rng.MoveEndUntil "〕"
' rng.SetRange rng.End + 2, rng.End + 2
' End If
' rng.InsertAfter corTxt
e = rng.End + 1
End If
'e = rng.End
pRng.SetRange e, p.Range.End
'pRng.SetRange rng.End, p.Range.End
Loop
End If
If VBA.Left(p.Range.text, 9) = ChrW(-9217) & ChrW(-8195) & ChrW(-9217) & ChrW(-8195) & "【《索隱》" Then
Set rng = p.Range
p.Range.Characters(1).Delete
rng.SetRange p.Range.start, p.Range.start
rng.InsertAfter "{{"
rng.SetRange p.Range.Characters(p.Range.Characters.Count - 4).End, p.Range.Characters(p.Range.Characters.Count - 4).End
rng.InsertAfter "}}"
If Len(rng.Paragraphs(1).Next.Range.text) = 1 Then rng.Paragraphs(1).Next.Range.Delete
End If
If Len(p.Range) < 20 Then
If (InStr(p.Range, "《史記》卷") Or VBA.Left(p.Range.text, 3) = "史記卷") And InStr(p.Range, "*") = 0 Then
rng.SetRange p.Range.start, p.Range.start
rng.InsertAfter "*"
For Each pa In p.Range.Characters
If pa Like "[〈《》〉]" Or StrComp(pa, ChrW(-9217) & ChrW(-8195)) = 0 Then pa.Delete
Next pa
'以下方式會造成p 值被設定為下一個段落
' p.Range.text = VBA.Replace(p.Range.text, ChrW(-9217) & ChrW(-8195) & ChrW(-9217) & ChrW(-8195), "")
' p.Range.text = VBA.Replace(VBA.Replace(p.Range.text, "《", ""), "》", "")
End If
End If
If Len(p.Range) < 25 Then
If VBA.InStr(p.Range.text, "第") And InStr(p.Range, "*") = 0 _
And (InStr(p.Range, "本紀") Or InStr(p.Range, "書") Or InStr(p.Range, "表") _
Or InStr(p.Range, "世家") Or InStr(p.Range, "列傳")) Then
rng.SetRange p.Range.start, p.Range.start
rng.InsertAfter " *"
For Each pa In p.Range.Characters
If pa Like "[〈《》〉]" Or StrComp(pa, ChrW(-9217) & ChrW(-8195)) = 0 Then pa.Delete
Next pa
' p.Range.text = VBA.Replace(p.Range.text, ChrW(-9217) & ChrW(-8195) & ChrW(-9217) & ChrW(-8195), " *")
' p.Range.text = VBA.Replace(VBA.Replace(p.Range.text, "〈", ""), "〉", "")
End If
End If
Next p
If VBA.Left(d.Paragraphs(1).Range.text, 3) = "史記卷" And InStr(d.Paragraphs(1).Range.text, "*") = 0 Then
Set p = d.Paragraphs(1)
rng.SetRange p.Range.start, p.Range.start
rng.InsertAfter "*"
' rng.SetRange p.Range.Characters(p.Range.Characters.Count - 1).End, p.Range.Characters(p.Range.Characters.Count - 1).End
' rng.InsertAfter "<p>"
End If
If VBA.InStr(d.Paragraphs(2).Range.text, "第") And InStr(d.Paragraphs(2).Range.text, "*") = 0 Then
Set p = d.Paragraphs(2)
' rng.SetRange p.Range.start, p.Range.start
' rng.InsertAfter " *"
'' rng.SetRange p.Range.Characters(p.Range.Characters.Count - 1).End, p.Range.Characters(p.Range.Characters.Count - 1).End
'' rng.InsertAfter "<p>"
p.Range.text = VBA.Replace(p.Range.text, ChrW(-9217) & ChrW(-8195) & ChrW(-9217) & ChrW(-8195), " *")
Set p = d.Paragraphs(2)
p.Range.text = VBA.Replace(VBA.Replace(p.Range.text, "〈", ""), "〉", "")
End If
'Set rng = d.Range
'Do While rng.Find.Execute("〕", , , , , , True, wdFindStop)
' If rng.Characters(1).Next <> "＝" Then rng.InsertAfter corTxt
'Loop
'Set rng = d.Range
'Do While rng.Find.Execute("）", , , , , , True, wdFindStop)
' If InStr("＝〔", rng.Characters(1).Next) = 0 Then rng.InsertAfter corTxt
'Loop
d.Range.Cut
d.Close wdDoNotSaveChanges
Beep
word.Application.ActiveWindow.WindowState = wdWindowStateMinimize
End Sub
Sub 書名號篇名號標注()
Dim cnt As New ADODB.Connection, rst As New ADODB.Recordset
Dim cntStr As String, d As Document, dx As String, rngF As Range
If Dir("H:\我的雲端硬碟\私人\千慮一得齋(C槽版)\書籍資料\圖書管理附件", vbDirectory) <> "" Then
cntStr = "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=H:\我的雲端硬碟\私人\千慮一得齋(C槽版)\書籍資料\圖書管理附件\查字.mdb;"
ElseIf Dir("D:\千慮一得齋\書籍資料\圖書管理附件", vbDirectory) <> "" Then
cntStr = "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=D:\千慮一得齋\書籍資料\圖書管理附件\查字.mdb;"
Else
MsgBox "路徑不存在！", vbCritical: Exit Sub
End If
Set d = ActiveDocument: dx = d.Range.text: Set rngF = d.Range
cnt.Open cntStr
GoSub bookmarks '標點符號_書名號_自動加上用
rst.Open "select * from 標點符號_篇名號_自動加上用 order by 排序", cnt
Set rngF = d.Range: dx = d.Range.text
Do Until rst.EOF
If VBA.InStr(dx, rst("篇名").Value) Then 'if found
Do While rngF.Find.Execute(rst("篇名").Value, , , , , , True, wdFindStop)
If InStr("》〉·‧", IIf(rngF.Characters(rngF.Characters.Count).Next Is Nothing, "", rngF.Characters(rngF.Characters.Count).Next)) = 0 And _
InStr("《〈·‧", IIf(rngF.Characters(1).Previous Is Nothing, "", rngF.Characters(1).Previous)) = 0 Then
If VBA.IsNull(rst("取代為").Value) Then
rngF.text = "〈" & rst("篇名").Value & "〉"
'd.Range.Find.Execute rst("篇名").Value, , , , , , True, wdFindContinue, , "〈" & rst("篇名").Value & "〉", wdReplaceAll
Else
rngF.text = rst("取代為").Value
'd.Range.Find.Execute rst("篇名").Value, , , , , , True, wdFindContinue, , rst("取代為").Value, wdReplaceAll
End If
End If
Loop
End If
Set rngF = d.Range: dx = d.Range.text
rst.MoveNext
Loop
d.Range.Find.Execute "《《", , , , , , True, wdFindContinue, , "《", wdReplaceAll
d.Range.Find.Execute "》》", , , , , , True, wdFindContinue, , "》", wdReplaceAll
d.Range.Find.Execute "〈〈", , , , , , True, wdFindContinue, , "〈", wdReplaceAll
d.Range.Find.Execute "〉〉", , , , , , True, wdFindContinue, , "〉", wdReplaceAll
'GoSub bookmarks 'do again to check and correct SHOULD BE use another table to do this
rst.Close: cnt.Close
Exit Sub
bookmarks:
If rst.State = adStateOpen Then rst.Close
rst.Open "select * from 標點符號_書名號_自動加上用 order by 排序", cnt
Do Until rst.EOF
If VBA.InStr(dx, rst("書名").Value) Then 'if found
Do While rngF.Find.Execute(rst("書名").Value, , , , , , True, wdFindStop)
If InStr("》〉·‧", IIf(rngF.Characters(rngF.Characters.Count).Next Is Nothing, "", rngF.Characters(rngF.Characters.Count).Next)) = 0 And _
InStr("《〈·‧", IIf(rngF.Characters(1).Previous Is Nothing, "", rngF.Characters(1).Previous)) = 0 Then
If VBA.IsNull(rst("取代為").Value) Then
rngF.text = "《" & rst("書名").Value & "》"
' d.Range.Find.Execute rst("書名").Value, , , , , , True, wdFindContinue, , "《" & rst("書名").Value & "》", wdReplaceAll
Else
rngF.text = rst("取代為").Value
' d.Range.Find.Execute rst("書名").Value, , , , , , True, wdFindContinue, , rst("取代為").Value, wdReplaceAll
End If
End If
Loop
End If
Set rngF = d.Range: dx = d.Range.text
rst.MoveNext
Loop
rst.Close
Return
End Sub
Sub 表sub()
Dim p As Paragraph, d As Document, rng As Range, s As Long, e As Long
Set d = Documents.Add(): Set rng = d.Range
d.Range.Paste
For Each p In d.Paragraphs
If InStr(p.Range, "《索隱》：") Or _
InStr(p.Range, "《正義》：") Or _
InStr(p.Range, "《集解》：") Then
If InStr(p.Range, "{{") = 0 Then
s = p.Range.Characters(1).start
rng.SetRange s, s
rng.InsertBefore "{{"
e = p.Range.Characters(p.Range.Characters.Count - 4).End
rng.SetRange e, e
rng.InsertAfter "}}"
End If
End If
Next p
d.Range.Cut
d.Close wdDoNotSaveChanges
Beep
End Sub
Sub 新頁面()
'the page begin
Const start As Integer = 2353
' the page end
Const e As Integer = 2373
' the book
Const fileID As Long = 1000081
'https://ctext.org/library.pl?if=gb&file=1000081&page=2621
Dim x As String, data As New MSForms.DataObject
Dim i As Integer
For i = start To e
x = x & "" & Chr(9) & "" '若中間沒有任何內容，頁面最後便不能成一段落。若剛好一個段落，會與下一頁黏合在一起
Next i
'For Each e In Selection.Value
' x = x & e
'Next e
''x = Replace(x, Chr(13), "")
data.SetText Replace(x, "/>", "/>●", 1, 1)
data.PutInClipboard
End Sub
留言