VBAProg’s diary

今日も以前掲載した記事をUpしてみます。

日本語の文字列は、通常　S-JIS 文字コードにエンコードされていますが、UNIX系ではEUC 文字コードが使われます。

例えばサーバー上で動作するCGI/Perlの場合、

httpのindex URLの後ろにsearch?keywords＝%BB%B3%C5%C4

と書かれたりします。

この場合、該当するページで検索キーワードで検索ができます。

ちなみに↑の例は　「山田」という日本語をEUC エンコードしたものです。

これを実際にVBでエンコードする場合、エンコード用の変換コード表を、CSVファイルなどに落としておいて、Open ステートメントで開いて、文字列変数などに入力し、CLRやコンマ等で分割して、配列変数に入れるという厄介な手法になります。

その点、表計算ソフトのExcelでは、Sheetに変換コードを貼り付けるだけでデータの管理ができるのでとても便利です。

VBAはExcelで使えるPrograming言語ですから、VBAで変換してみましょう。

手順は次の通りです。

①入力する文字列をSheet上に入力する

②入力された文字列を１文字づつ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

End Function

の形になります。

()内に入力値を入れるとAという値が出ます。

（）内のByval は値渡しと言って、変数の値を渡します。

l_st = Len(st)

のLen()は、文字数を求める関数です。

For i = 1 To l_st

の構文は、iの値が１からl_stまで１づつ増やして繰り返すというものです。

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から送られてきた１文字を変換します。

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とｙが取得できます。

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)は、配列の１番目の要素数となります。

この場合、行数となります。

次に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は、１つの変数しか返せないので、参照渡しで同時に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とｙに値を入れています。

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

EUC 文字コード表は、1列目（A列）にアドレスを

2～17列（B～Q列）に対象文字があります。

アドレスは、4桁の16進数で書かれ、１桁目が０です。

２～17列がそれぞれ末尾の桁の0～15に相当します。

16進数は、0～９とA～Fの組み合わせで、表します。

Aは10、Fは15となります。

FindArrayで見つけたｙから

アドレス

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)　１桁目
Encode = s2 + u2 + s2 + u3 + u4

最後に%で2文字づつに分けて返します。

2022年8月16日　記載　2022年9月17日改訂

追伸　9月19日（月）頃　台風が上陸しそうです。

九州地方は、被害が心配です。

先日、今まで使っていたサーバーが落ちてしまったので

こちらに引っ越してきましたのでよろしくお願いいたします。

ファイル

↑は、以前にアップロードしたデータの改良版です。

ご自由にお使いください。

※Excelシート上のデータは、クリアしています。

VBEのクラスモジュール内に、FunctionとSubを移動しましたのでご注意ください。

このファイルは元々、VB.NETで作っていたものですが、より汎用性が高くなるようにと、VBAで作ってみました。

本来はWEB上のデータをスクレイピングし、データを収集する目的のアプリでしたが

Excelに移植するにあたり、Webへのアクセスとスクレイピング機能を削除し

データの整理機能に特化したものに変更いたしました。

Function動作について

・日本語→EUC 文字コード変換

・シート上データの配列変数への変換

・配列変数からシートデータへの出力

・重複データの削除　ソート機能

・Worksheetオブジェクトの変数への登録

・テキストデータから任意の文字列の抽出とデータベース化

※上記機能は、テキストファイルへのアクセスを制限しています。

・シートデータから任意のデータの抽出

以上となります。

今後とも以前の記事を復活させていく予定ですので、よろしくお願いいたします。

2022年8月15日記載　9月15日改訂

VBAProg’s diary

SpreadsheetのGoogle Apps Script

EUCエンコードについて

VBAでデータ整理