Ebsdicの文字コ一ド出力へと変換を行う
通信で文字列を扱っている状況で、ANSIコードからEbsdicの文字コ一ドに変換を行った上で、元のものと一致するかどうかを確かめる機会があったので効率化のためにExcelのVBAでマクロを組んだので情報共有を行う。
確認：そもそも文字コードとは?
PCで使われる情報は電気信号が基となっている。これは表示される文字についても例外ではなく、PCに元々ある電気信号を一定の規則に基づいて文字という形に符号化変換することで人間に分かる文字という形になる。
この電気信号を文字に変換する規則のことを文字コ－ドという。
通常使用する分には意識する必要はないが、文字コードが正しくない状況では、文字化けして文字を読むことができなくなるため、文字コ－ドが異なる場合は文字コードの変換を行う必要がある。
ソースコ一ド
ソースコードは下記の通り
Sub exchange_ebsdic ()
'----------------------------------------------
'概要: 指定フォルダ内の指定列のanciコードの数字をEBSDICの数字に変換する
'機能名: exchange_ebsdic
'引数: なし
'戻り値: なし
'備考:なし
'----------------------------------------------
Dim myPath As String
Dim kakutyoshi As String
Dim myBook_name As String
Dim mySheet_name As String
Dim row_number As Integer
Dim column_number As Integer
Dim start_row As Integer
Dim last_row As Integer
Dim search_column_number As Integer
Dim sansyo_column_number As Integer
Dim note_column_number As Integer
Dim note_str As String
Dim note_2_column_number As Integer
Dim note_2_str As String
Dim changed_flg As Integer
Dim replace_flg As Integer
Dim search_val As String
Dim sansyo_val As String
changed_flg = 0
If ThisWorkbook.Worksheets(1).Cells(3, 3).Value = "" Then
'セルが空欄だった場合、デフォルトの値をセット
Else
myPath = ThisWorkbook.Worksheets(1).Cells(3, 3).Value & "\"
End If
kakutyoshi = ThisWorkbook.Worksheets(1).Cells(4, 3).Value
'拡張子に値が設定されていなかったらデフォルトでxlsxをセット
If kakutyoshi = "" Then
kakutyoshi = "xlsx"
End If
If ThisWorkbook.Worksheets(1).Cells(5, 3).Value = "" Then
'値が入っていない場合、デフォルトで一番上の行を指定
start_row = 1
Else
start_row = ThisWorkbook.Worksheets(1).Cells(5, 3).Value
End If
'値が入力されていなかったら、デフォルトで1列目を対象にする
If ThisWorkbook.Worksheets(1).Cells(7, 3).Value = "" Then
sansyo_column_number = 1
Else
search_column_number = ThisWorkbook.Worksheets(1).Cells(7, 3).Value
End If
'隣の列を取得
If ThisWorkbook.Worksheets(1).Cells(8, 3).Value = "" Then
sansyo_column_number = 0
Else
sansyo_column_number = ThisWorkbook.Worksheets(1).Cells(8, 3).Value
End If
'追記メモ記載列を取得
If ThisWorkbook.Worksheets(1).Cells(9, 3).Value = "" Then
note_column_number = 0
Else
note_column_number = ThisWorkbook.Worksheets(1).Cells(9, 3).Value
End If
'追記メモ内容を取得
note_str = ThisWorkbook.Worksheets(1).Cells(10, 3).Value
'書換メモ記載列を取得
If ThisWorkbook.Worksheets(1).Cells(11, 3).Value = "" Then
note_2_column_number = 0
Else
note_2_column_number = ThisWorkbook.Worksheets(1).Cells(11, 3).Value
End If
'書換メモ内容を取得
note_2_str = ThisWorkbook.Worksheets(1).Cells(12, 3).Value
'値の書換有無を取得
replace_flg = ThisWorkbook.Worksheets(1).Cells(13, 3).Value
myBook_name = Dir(myPath & "*" & kakutyoshi)
'Dir関数がファイル名を返さなくなるまで繰り返す
Do Until myBook_name = ""
'ファイル名のブックを開く
Workbooks.Open myPath & myBook_name
If ThisWorkbook.Worksheets(1).Cells(6, 3).Value = "" Then
'値が入っていなかったら、30列分の最終行を自動取得
last_row = 0
For column_number = 1 TO 30
If last_row < Workbooks(myBook_name).Worksheets(1).Cells(Rows.Count,column_number).End(xlup).Row Then
last_row = Workbooks(myBook_name).Worksheets(1).Cells(Rows.Count,column_number).End(xlup).Row
End If
Next column_number
'それでも最終行が見つからないときは、デフォルトの値を入れる
If last_row = 0 Then
last_row = 50
End If
Else
'最終行を取得
last_row = ThisWorkbook.Worksheets(1).Cells(6, 3).Value
End If
'縦にそってループ
For row_number = start_row TO last_row
'セルの値を取得
search_val = Workbooks(myBook_name).Worksheets(1).Cells(row_number, search_column_number).Value
If 0 < sansyo_column_number Then
sansyo_val = Workbooks(myBook_name).Worksheets(1).Cells(row_number, sansyo_column_number).Value
End If
'設計値と新電文の値が一致していることを確認する
If sansyo_val <> search_val Then
'--------------------------------------------------------------------
'--------------------EBSDIC変換処理-----------------------------------
'--------------------------------------------------------------------
'値を再取得
search_val = Workbooks(myBook_name).Worksheets(1).Cells(row_number, search_column_number).Value
If 0 < sansyo_column_number Then
sansyo_val = Workbooks(myBook_name).Worksheets(1).Cells(row_number, sansyo_column_number).Value
End If
search_val = exchange_ebs(search_val)
'デバッグコード(変数の値表示)
'MsgBox (search_val)
If sansyo_column_number = 0 Then
'比較対象列が存在しない場合、すべてEBSDICに変換する
If replace_flg = 1 Then
Workbooks(myBook_name).Worksheets(1).Cells(row_number, search_column_number).Value = search_val
End If
changed_flg = 1
If 0 < note_2_column_number Then
'変換を実施した場合、メモ欄を書換える
Workbooks(myBook_name).Worksheets(1).Cells(row_number, note_2_column_number).Value = note_2_str
End If
Else
'比較対象列が存在する場合、一致したもののみEBSDICに変換する
If sansyo_val = search_val Then
'EBSDICに変換した結果、比較対象と一致していたら変換を実行
If replace_flg = 1 Then
Workbooks(myBook_name).Worksheets(1).Cells(row_number, search_column_number).Value = search_val
End If
Changed_flg = 1
if 0 < note_column_number Then
'変換を実施した場合、メモ欄に変更履歴を追加する
Workbooks(myBook_name).Worksheets(1).Cells(row_number, note_column_number).Value = Workbooks(myBook_name).Worksheets(1).Cells(row_number, note_column_number).Value & vbLf & note_str
End If
If 0 < note_2_column_number Then
'変換を実施した場合、メモ欄を書換える
Workbooks(myBook_name).Worksheets(1).Cells(row_number, note_2_column_number).Value = note_2_str
End If
ElseIf sansyo_val = LCase(search_val) Then
'小文字の16進数に変換した結果、比較対象と一致していたら変換を実行
If replace_flg = 1 Then
Workbooks(myBook_name).Worksheets(1).Cells(row_number, search_column_number).Value = LCase(search_val)
End If
Changed_flg = 1
if 0 < note_column_number Then
'変換を実施した場合、メモ欄に変更履歴を追加する
Workbooks(myBook_name).Worksheets(1).Cells(row_number, note_column_number).Value = Workbooks(myBook_name).Worksheets(1).Cells(row_number, note_column_number).Value & vbLf & note_str
End If
If 0 < note_2_column_number Then
'変換を実施した場合、メモ欄を書換える
Workbooks(myBook_name).Worksheets(1).Cells(row_number, note_2_column_number).Value = note_2_str
End If
End If
End If
End If
'デバッグコード(操作済の部分に色をつける)
'Workbooks(myBook_name).Worksheets(1).Cells(row_number, search_column_number).Interior.Color = RGB(255, 255, 0)
Next row_number
'ブックが変更されていない
IF changed_flg = 0 Then
Workbooks(mybook_name).Close SaveChanges := False
'ブックが変更されている
Else
Workbooks(mybook_name).Close SaveChanges := True
End If
changed_flg = 0
myBook_name = Dir
Loop
End Sub
Function exchange_ebs(str_anci as String)
'----------------------------------------------
'概要: str_anciコードの数字をEBSDICコードに変換する
'機能名: exchange_ebsdic
'引数: str_anci
'戻り値: exchange_ebs
'備考:変換の規則については下記の通り
' 0→F0
' 1→F1
' 2→F2
' 3→F3
' 4→F4
' 5→F5
' 6→F6
' 7→F7
' 8→F8
' 9→F9
' A→C1
' B→C2
' C→C3
' D→C4
' E→C5
' F→C6
'----------------------------------------------
Dim str_ebsdic As String
Dim str_tmp As String
Dim mozi_count As Integer
'文字列を取得
mozi_count = 1
'最初の文字順番に取得
str_tmp = Mid(str_anci, 1, 1)
While str_tmp <> ""
'文字を変換
Select Case str_tmp
Case 0
str_tmp = "F0"
Case 1
str_tmp = "F1"
Case 2
str_tmp = "F2"
Case 3
str_tmp = "F3"
Case 4
str_tmp = "F4"
Case 5
str_tmp = "F5"
Case 6
str_tmp = "F6"
Case 7
str_tmp = "F7"
Case 8
str_tmp = "F8"
Case 9
str_tmp = "F9"
Case A,a
str_tmp = "C1"
Case B,b
str_tmp = "C2"
Case C,c
str_tmp = "C3"
Case D, d
str_tmp = "C4"
Case E,e
str_tmp = "C5"
Case F,f
str_tmp = "C6"
End Select
'変換後文字列に追記
str_ebsdic = str_ebsdic + str_tmp
mozi_count = mozi_count + 1
'文字を順番に取得
str_tmp = Mid(str_anci, mozi_count, 1)
Wend
'MsgBox str_anci
'MsgBox str_ebsdic
exchange_ebs = str_ebsdic
End Function