読書の秋ですね。
というか秋を通り越して冬見たく寒くなっているところもあるようですが、体調管理には気をつけなければなりません。
本好きの私、中国暮らしが長くなると、日本語の本を読みたくなるのですが、
気軽に行ける本屋などなく、日本に帰国するチャンスにどっさり買い込んでくるようにしています。
ただ、そうはいっても、なかなかお金にも輸送コストにも限界があるので、できれば電子化したいところです。
私たちのような海外勢の強い見方として、「
青空文庫」があります。著作権が切れた本をボランティアがtxt化してアップロードしているサイトです。ダイソーの100円の文庫本もここからダウンロードして作っているようです。
私はそれを中国の携帯電話で読みたいと思いました。
私の携帯電話は、USB経由でtxtファイルを読み込みことができます。
しかし、私の携帯電話のバージョンが余り新しくないせいなのか、日本語の漢字は文字化けします。
例えば、
「東京」は「东京」と書かなければ、「□u京」のように文字化けするのです。
これを解消するには、txtの段階で、日本語漢字を中国語漢字（簡体中国語）に直す必要があります。
そのために開発したのが、下記マクロです。
Sub JA_to_CN_CONVERTION_MACRO()
と
Sub 桁数あふれ修正()
の二部構成で、
先にSub 桁数あふれ修正()で900文字以上のものを900文字にそろえてから、
Sub JA_to_CN_CONVERTION_MACRO() で日本語漢字を簡体中国語に置き換える。
ひとつのセルに911文字以上入っていると、エクセルの「置換」機能がうまく働かないことが判明したので、このようなステップをとることにしました。
さっき、やっと桁あふれ修正部分が完成したので、ブログにupします。
あらかじめ、シート「list」にこんな表を用意しておく必要がある。
問題は、このリストをいかに充実しておくかである。
もし、リストに載っていない漢字があると文字化けする必要がある。。。
シート「TEXT」には下記のように貼り付けます。
-------------------------------
Option Explicit
Sub JA_to_CN_CONVERTION_MACRO()
'2008-06-22 VERSION 0.1 BY YOICHI SANO
'非表示機能
Application.ScreenUpdating = False
Dim JAPANESE As String
Dim CHINESE As String
Dim i As Integer ' COUNTER
Dim lastrow As Integer 'LASTROW
'LASTROW
Sheets("list").Select
lastrow = Cells(1, 1).End(xlDown).Row
For i = 1 To lastrow
Sheets("list").Select
JAPANESE = Cells(i, 1)
CHINESE = Cells(i, 2)
Sheets("TEXT").Select
Cells.Replace What:=JAPANESE, Replacement:=CHINESE, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next i
'INDICATOR表示を削除
Application.StatusBar = False
MsgBox ("COMPLETE")
End Sub
--------------------------------------------------------------
Sub 桁数あふれ修正()
Dim k As Integer ' 変換シート用列カウンター
Dim r As Integer '追加する列を計算するようのカウンター
Dim t As Integer '追加するテキストを分解するときの列カウンター
Dim text_lastrow As Integer ' textシートの最終行
'text_lastrow
Sheets("TEXT").Select
Cells(1, 1).Select
text_lastrow = ActiveCell.SpecialCells(xlLastCell).Row
For k = 1 To text_lastrow
If Len(Cells(k, 1)) > 900 Then
r =
Application.WorksheetFunction.RoundUp(Len(Cells(k, 1)) / 900, 0)
'Application.WorksheetFunctionがないと、roundupが作動しない
'列の追加
Range(Cells(k + 1, 1), Cells(k + r, 1)).Select
Selection.Insert Shift:=xlDown
'長い文書の分解
Cells(k + 1, 1) = Left(Cells(k, 1), 900)
For t = 2 To r
Cells(k + t, 1) = Mid(Cells(k, 1), 900 * (t - 1) + 1, 900)
Next t
'列の削除
Range(Cells(k, 1), Cells(k, 1)).Select
Selection.Delete Shift:=xlUp
text_lastrow = text_lastrow + r
End If
Next k
End Sub
