フォルダ内の全ファイルの指定列を10進数から16進数に変換する
エクセルのシート上の1列分全ての10進数を16進数に書き換えたり、16進数に変換した上で正しい値になっているかを比較するということがあった。
そのため、まとめて変換、確認をするためのツ一ルを作成したため備忘を兼ねて共有する。
1: そもそも16進数とは
通常の0～9を用いた数の表記法は数字を10種類使っていることから10進数と呼ばれている。
それに対して、16進数は16種類の数字を使った数の表記法を指している。
16進数はコンピュータを扱う時にたまにつかわれている。
その背景には、コンピュータが1ビットあたり0か1の2種類の情報を持つことができる仕組みにあります。16進数を用いると、1つの数字でちょうど4ビット分の情報表記することができて、機械処理に都合がいいとされています。
また、一般的には十進数での10～15にあたる数字はa～eの数字が使われています。
蛇足ですが、数学が好きな身としては数字としてアルファベットを使うというのはあまり好きではなく、数字は下記の思いつきのような数字専用の文字を使った方が混乱を生まなくていいよなぁとは思ったりしています。
2:入力フォーム
本VBAのプログラムは下記のフォームのもとで実行することを前提としています。
3:ソースコ一ド
ダラダラと16進数について話してしまいましたが、本題のVBAのコ一ドは下記の通りです。
Sub change_hex()
'----------------------------------------------
'概要: 10進数の数字を16進数に変換する
'機能名: change_hex
'引数: なし
'戻り値: なし
'備考:なし
'----------------------------------------------
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
search_val_ketasu = Len(search_val)
sansyo_val_ketasu = Len(sansyo_val)
'桁数が一致していなかったら、左に0を追加する
'設計値と新電文の値が一致していることを確認する
If sansyo_val <> search_val Then
'数字じゃなかったら処理をスキップ
If IsNumeric(search_val) Then
'--------------------------------------------------------------------
'----------------桁揃え処理(10桁まで対応)----------------------------
'--------------------------------------------------------------------
if search_val_ketasu < sansyo_val_ketasu Then
search_val = Right("0000000000" & search_val , sansyo_val_ketasu)
End If
If sansyo_val = search_val Then
'桁数揃えで一致したら代入し、以下の処理をスキップ
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
'--------------------------------------------------------------------
'--------------------16進数変換処理-----------------------------------
'--------------------------------------------------------------------
'値を再取得
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 2147483647 < search_val Then
'オ一バーフローするようなら、通知した上で処理をスキップする
Msgbox("オ一バ一フロ一により、処理をスキップします。")
Else
search_val = Hex(search_val)
if search_val_ketasu < sansyo_val_ketasu Then
search_val = Right("0000000000" & search_val , sansyo_val_ketasu)
End If
'デバッグコード(変数の値表示)
'MsgBox (search_val)
If sansyo_column_number = 0 Then
'比較対象列が存在しない場合、すべて16進数に変換する
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
'比較対象列が存在する場合、一致したもののみ16進数に変換する
If sansyo_val = search_val Then
'16進数に変換した結果、比較対象と一致していたら変換を実行
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
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
4:使用方法
本マクロプログラムは、Excelでの使用を想定しいます。また、指定できる列は1列づつとなっております。
また、使える機能は大きく2通りであり、使い分け方と合わせて説明すると以下の通りです
- 16進数への変換のみを行う場合
- →8行目(C8のセル)に空白、又は0を設定する
- 比較元が16進数と一致しているかを確認し、していたら変換を行う場合
- →8行目(C8のセル)に正の整数を設定する