EUCエンコードについて
今日も以前掲載した記事をUpしてみます。
日本語の文字列は、通常 S-JIS文字コードにエンコードされていますが、UNIX系ではEUC文字コードが使われます。
httpのindex URLの後ろにsearch?keywords=%BB%B3%C5%C4
と書かれたりします。
この場合、該当するページで検索キーワードで検索ができます。
ちなみに↑の例は 「山田」という日本語をEUCエンコードしたものです。
これを実際にVBでエンコードする場合、エンコード用の変換コード表を、CSVファイルなどに落としておいて、Open ステートメントで開いて、文字列変数などに入力し、CLRやコンマ等で分割して、配列変数に入れるという厄介な手法になります。
その点、表計算ソフトのExcelでは、Sheetに変換コードを貼り付けるだけでデータの管理ができるのでとても便利です。
VBAはExcelで使えるPrograming言語ですから、VBAで変換してみましょう。
手順は次の通りです。
①入力する文字列をSheet上に入力する
②入力された文字列を1文字づつEncodeする。
③EncodeされたコードをSheet上に出力する。
こんな形でしょうか。
実際に書いてみると
Sub EncodeGet()
Dim s_sheet, st_sorce As String
Dim ws As Worksheet
s_sheet = "input"
Set ws = Worksheets(s_sheet)
st_sorce = ws.Cells(1, 2)
ws.Cells(2, 2) = EncodeMain(st_sorce)
End Sub
こうなります。
Sub ~End Sub をMethodといいます。
実行するProgramです。
EncodeGetという名前にしてみました。
Dim 〇〇As ××
とは、○○という変数を××という型で定義すると宣言しています。
Stringは文字型、WorksheetはSheetオブジェクトの型です。
①の部分ですが
例えばsheet1のセルB1に入力するものとします。
入力された文字列を変数に入力する方法は、幾通りも存在します。
st_sorce=Cells(1, 2)
と書くのが一般的でしょうか。
ただこの場合、Sheetが複数あると、ActiveなSheetが選ばれてしまうのでSheetを指定します。
例えば
st_sorce=Sheet1.Cells(1,2)
としても良いし、Sheet1のシート名がinputだった場合
st_sorce=Sheets("input").Cells(1,2)
という方法もあります。
今回は
Dim s_sheet, st_sorce As String
Dim ws As Worksheet
s_sheet = "input"
Set ws = Worksheets(s_sheet)
st_sorce = ws.Cells(1, 2)
という風にしました。
②のEncodeですが
ちょっと複雑ですので、いくつかの関数を作ります。
EncodeMain:メインの変換関数
Encode1st:1文字づつ変換する関数
Read_Array:シートの表を配列変数に読み込む関数
FindArray:配列変数から文字を検索する関数
Encode:配列の位置からEncodeする関数
③で最後に
ws.Cells(2, 2) = EncodeMain(st_sorce)
B2セルに変換された値を出力しています。
では途中の関数を見てみます。
Function EncodeMain(ByVal st As String) As String
Dim st_unit As String
Dim i, l_st As Integer
EncodeMain = ""
l_st = Len(st)
For i = 1 To l_st
st_unit = Mid(st, i, 1)
EncodeMain = EncodeMain + Encode1st(st_unit)
Next
End Function
関数は
Function A() as B
A=
End Function
の形になります。
()内に入力値を入れるとAという値が出ます。
()内のByval は値渡しと言って、変数の値を渡します。
l_st = Len(st)
のLen()は、文字数を求める関数です。
For i = 1 To l_st
Next
の構文は、iの値が1からl_stまで1づつ増やして繰り返すというものです。
st_unit = Mid(st, i, 1)
のMid()は、st文字列のi番目の1文字を取得するという関数です。
EncodeMain = EncodeMain + Encode1st(st_unit)
この式は、Encode1stで変換した文字列を足し合わせるという式です。
続いてEncode1stについて
Function Encode1st(ByVal st As String) As String
Dim ws As Worksheet
Dim Table1() As String
Dim sn As String
Dim y As Integer
Dim x As Integer
Dim n, m As Integer
x = 0: y = 0
sn = "EUC"
Set ws = Worksheets(sn)
m = 17
n = Read_Array(ws, Table1(), m)
If FindArray(Table1(), st, y, x, n, m) = False Then Encode1st = "%##": Exit Function
If x = 1 Then Encode1st = "%##": Exit Function
Encode1st = Encode(Table1(), y, x)
End Function
EncodeMainから送られてきた1文字を変換します。
sn = "EUC"
Set ws = Worksheets(sn)
m = 17
n = Read_Array(ws, Table1(), m)
の部分は、"EUC"というSheet上のコード表をTable1()という配列変数に取り込みます。
Read_Array関数については、後述します。
If FindArray(Table1(), st, y, x, n, m) = False Then Encode1st = "%##": Exit Function
If x = 1 Then Encode1st = "%##": Exit Function
の部分は、
Table1()の中に、該当する文字はどの位置にいるのかを求めています。
結果として、xとyが取得できます。
If 条件 Then
は、ある条件が成立した時に実行するいうものです。
FindArray関数の出力はBoolean型でTrueかFalseで返します。
もし、検索が失敗した場合”%##”で返し、Exit Functionで関数から抜けるようにしています。
また、検索結果の列がA列だった場合も同様の処置をしています。
Encode1st = Encode(Table1(), y, x)
この部分で、最終変換しています。
続いて Read_Array関数について
Function Read_Array(ByVal ws As Worksheet, ByRef ar() As String, ByVal m As Integer) As Integer
Dim i, j, n As Integer
i = 1
Do
If ws.Cells(i, 1) = "" Then Exit Do
i = i + 1
Loop
n = i - 1
ReDim ar(n, m)
For i = 1 To n
For j = 1 To m
ar(i, j) = ws.Cells(i, j)
Next
Next
Read_Array = UBound(ar, 1)
End Function
Function Read_Array(ByVal ws As Worksheet, ByRef ar() As String, ByVal m As Integer) As Integer
最初の宣言が長いのですが
ws:Sheet
ar():入力する配列
配列の受け渡しは、ByRefでなければなりません。
ByRefは参照渡しと言って、関数内でその変数の値を変えると呼び出した元の変数も変わるというものですので、取り扱いに気をつけなければなりません。
m:入力する列数
Read_Array:取得した行数を返します。
i = 1
Do
If ws.Cells(i, 1) = "" Then Exit Do
i = i + 1
Loop
n = i - 1
の部分は、Do Loop間で繰り返す構文で
Sheet内を順番に調べて行って
If ws.Cells(i, 1) = "" Then Exit Do
の部分で、空白のセルがあったらループから抜け出すことにしています。
これで表の最終行が見つけられます。
ReDim ar(n, m)
は、配列の大きさを決めます。
n行m列の配列を定義しています。
ar(i, j) = ws.Cells(i, j)
の部分で、配列変数にセルの値を入力しています。
また
For i = 1 To n
For j = 1 To m
ar(i, j) = ws.Cells(i, j)
Next
Next
の形は2次配列の取り扱いによく使われます。
Read_Array = UBound(ar, 1)
は、配列の大きさを返しています。
UBound(ar, 1)は、配列の1番目の要素数となります。
この場合、行数となります。
次にFindArrayについて
Function FindArray(ByRef ar() As String, ByVal st As String, ByRef y As Integer, ByRef x As Integer, ByVal n As Integer, ByVal m As Integer) As Boolean
x = 0: y = 0
For i = 1 To n
For j = 1 To m
If st = ar(i, j) Then x = j: y = i
Next
Next
If x > 0 And y > 0 Then FindArray = True Else FindArray = False
End Function
ar():検索する配列
st:検索する文字
y:検索結果の行
x:検索結果の列
n:配列の行数
m:配列の列数
ここで気を付ける点は、yとxは、ByRefにしている点です。
Functionは、1つの変数しか返せないので、参照渡しで同時に2つの変数を返しています。
x = 0: y = 0
For i = 1 To n
For j = 1 To m
If st = ar(i, j) Then x = j: y = i
Next
Next
この部分は、検索の部分で、検索文字と配列変数の値が一致した時に、
xとyに値を入れています。
If x > 0 And y > 0 Then FindArray = True Else FindArray = False
最後に、見つかった場合は、Trueを、見つからなかった、Falseを返しています。
最後の関数 Encodeについて
Function Encode(ByRef ar() As String, ByVal y As Integer, ByVal x As Integer) As String
Dim s1, s2, u1, u2, u3, u4 As String
s1 = "0123456789ABCDEF"
s2 = "%"
u1 = ar(y, 1)
u2 = Mid(u1, 1, 2)
u3 = Mid(u1, 3, 1)
u4 = Mid(s1, x - 1, 1)
Encode = s2 + u2 + s2 + u3 + u4
End Function
2~17列(B~Q列)に対象文字があります。
アドレスは、4桁の16進数で書かれ、1桁目が0です。
2~17列がそれぞれ末尾の桁の0~15に相当します。
16進数は、0~9とA~Fの組み合わせで、表します。
Aは10、Fは15となります。
FindArrayで見つけたyから
アドレス
u1 = ar(y, 1)を取得します。
s1 = "0123456789ABCDEF"
u4 = Mid(s1, x - 1, 1)
で、末尾の値を求めます。
s2 = "%"
u2 = Mid(u1, 1, 2) 4桁と3桁目
u3 = Mid(u1, 3, 1) 2桁目
u4 = Mid(s1, x - 1, 1) 1桁目
Encode = s2 + u2 + s2 + u3 + u4
最後に%で2文字づつに分けて返します。
2022年8月16日 記載 2022年9月17日改訂
追伸 9月19日(月)頃 台風が上陸しそうです。
九州地方は、被害が心配です。