PR

【VBA】10進数(符号付き/小数点対応)を2進数/16進数へ変換

これで楽に!?VBA活用
記事内に広告が含まれています。

こんにちは、Ryoです。
以前に10進数(符号なし)を2進数/16進数に変換するサンプルコードを投稿していますが今回は符号付き(小数点対応)についても作成してみましたので、その内容について書いていこうと思います。

スポンサーリンク

1.サンプル概要

基本構成としては以前に投稿したサンプルコードをベースとしているので、InputBoxへの10進数入力⇒符号有無判定と2進数/16進数変換を行いイミディエイトウィンドウに結果を出力するものです。

例として「55.005」「-55.005」をそれぞれInputBoxに入力し、変換を実行します。

次に「2021」「-2021」の入力、及び変換結果です。

2進数の結果出力は桁合わせを実施しています。整数部はmin8bitで小数部はmin4bitとし、整数部+小数部で8/16/24/32/64bitで判定します。

2.サンプルコード

Sub Sample1()

'※※※10進数(符号付き対応)⇒2進数/16進数へ変換※※※
  
  Dim ide As Boolean
  Dim ans, Dnum, quot As Variant
  Dim num As Long
  Dim flg, s, i, scnt, dcnt, nflg As Integer
  Dim bin_n, Dta, Dtb, dec_bin As String
  Dim cnt, cntA As Variant
  
  ide = False
  
  '変換元の数値入力用インプットボックス表示
  '数値以外の入力は受け付けずループするが、
  '「×」や「キャンセルボタン」で終了
  Do
    ans = InputBox("数値を入力してください。")
    If StrPtr(ans) = 0 Then Exit Sub
    If InStr(StrConv(ans, vbNarrow), "-") = 1 Then
          ans = Replace(StrConv(ans, vbNarrow), "-", "")  '一旦"-"を外す
          nflg = 1 '符号付き判定用
    End If
    If IsNumeric(ans) Then ide = True
  Loop Until ide = True

  '*************************
  '整数/小数の区分けと識別
  '*************************
  '入力値に"."が含まれているかどうかを判定
  If InStr(ans, ".") <> 0 Then
        'コンマが含まれていれば「整数部」=num、
        '「小数部」=Dnumにそれぞれ分ける
        'CDec関数を利用することで誤差を防ぐ
        num = CDec(Fix(ans))
        Dnum = CDec(ans) - CDec(Fix(ans))
     Else
        'コンマなしであれば整数のみと判定する
        num = ans
        flg = 1
  End If
  
  '元値の整数部が「0」である場合の処理
  Select Case num
    Case Is = 0
      bin_n = "0"
      cnt = 1
  End Select

  '*************************
  '整数部の10進数⇒2進数/16進数変換
  '*************************
   Do While num <> 0
       '元値を2で割り、商を求める
       quot = num \ 2
       '2進数表記の視認性向上を目的として4bit間隔で半角スペース
       If cnt <> "" And cnt Mod 4 = 0 Then bin_n = bin_n + Space(1)
       '2で割った際の余り=2進数
       bin_n = bin_n + CStr(num Mod 2)
       '次計算用として変数numへ商を代入
       num = quot
       'ビット数のカウント用
       cnt = cnt + 1
  Loop
  
  '桁合わせ試算用Functionプロシージャ(smp3)を実行
  '↓↓先頭bitが"1"であり、且つ"-"フラグ(nflg=1)であること、
  'または8で割り余りが0である場合の処理
  '前者条件は符号付きでの桁合わせ用、後者は符号なしでの桁合わせ用としての条件分岐
  If Mid(StrReverse(bin_n), 1, 1) = 1 And nflg = 1 Or cnt Mod 8 <> 0 Then
      cntA = smp3(cnt)
      '視認性向上の為の半角スペース追加
      If cnt >= 0 And cnt <> "" And cnt Mod 4 = 0 Then _
      bin_n = bin_n + Space(1)
  
      '桁合わせ必要数(=cntA)に応じて繰り返し処理を実行
      For i = 1 To cntA
          bin_n = bin_n + "0" '桁不足分”0”を追加
          If cntA <> i And (cnt + i) Mod 4 = 0 Then _
          bin_n = bin_n + Space(1)
      Next i
   End If
  
  '元値が整数のみ(flg=1)であれば変換した2進数と16進数を
  'イミディエイトウィンドウで表示
  If flg = 1 Then
  
  Select Case nflg
     Case Is <> 1
       Debug.Print "入力値(符号なし) : " & ans
       '上で計算して格納した2進数は逆順となっているので、
       'StrReverse関数を利用して並びを反転する
       Debug.Print "2進数: " & StrReverse(bin_n)
       '16進数変換用Functionプロシージャへの引渡し用として
       '変数Dtaに格納する
       Dta = StrReverse(bin_n)
       '16進数変換処理(smp2)を実行しイミディエイト
       'ウィンドウへ表示し終了する
       Debug.Print "16進数: " & smp2(Dta) & vbLf
       Exit Sub
      
      Case Is = 1
        Dta = StrReverse(bin_n)
        Dtb = smp4(Dta)
        Debug.Print "入力値(符号付き): " & "-" & ans
        Debug.Print "2進数: " & Dtb
        Debug.Print "16進数: " & smp2(Dtb) & vbLf
        Exit Sub
   End Select
      
  End If
  
  
 '*************************
  '小数部の10進数⇒2進数/16進数変換
 '*************************
  'ここまでの処理で完了している整数部の文字数をカウントする
  '(視認性のために設けた半角スペースを除去してカウント)
  s = Len(Replace(bin_n, " ", ""))
  
  'カウントした整数部の文字数に応じて
  '小数部の表示桁数を設定(主に32bit表示)
  Select Case s
     Case Is = 32
         scnt = 32
     Case Is < 32
         scnt = 32 - s
  End Select
  
  dcnt = 1
  
  '小数部を2進数に設定桁数分変換する
  Do While dcnt <= scnt
     '10進数の小数部を2倍して商を求める
     '商の小数部を繰り返し2倍することで2進数を計算する
     Dnum = (Dnum - Fix(Dnum)) * 2
     dec_bin = dec_bin + CStr(Fix(Dnum))
     If dcnt Mod 4 = 0 Then
         '視認性向上のための半角スペース追加
         dec_bin = dec_bin + Space(1)
         '商の小数部が”0”となる場合はループ強制終了
         If Dnum - Fix(Dnum) = 0 Then Exit Do
     End If
     dcnt = dcnt + 1
  Loop

  '整数部と小数部の2進数変換文字列数をカウントする
  cnt = Len(Replace(bin_n, " ", "")) + _
  Len(Replace(dec_bin, " ", ""))

   '総桁数が8/16/24/32/64bit以外であれば桁合わせ処理実行
   If cnt Mod 8 <> 0 Then
      cntA = smp3(cnt)
      bin_n = bin_n + Space(1)
      '半角スペース付加数をcntAに追加
      cntA = cntA + (cntA \ 4 - 1)
     
      For i = 1 To cntA
        If i Mod 5 = 0 Then
           bin_n = bin_n + Space(1)
         Else
           bin_n = bin_n + "0"
        End If
      Next i
   End If

   '桁合わせ処理完了後、整数部/カンマ/小数部を結合する
   Dta = StrReverse(bin_n) & " . " & dec_bin
    
   '入力元値の符号有無により処理を分岐させる
   If nflg = 1 Then
         Dtb = smp4(Dta)
         Debug.Print "入力値(符号付き): " & "-" & ans
         'イミディエイトウィンドウに表示する
         Debug.Print "2進数: " & Dtb
         '16進数変換用プロシージャにて処理を行いウィンドウに表示
         Debug.Print "16進数: " & smp2(Dtb) & vbLf
     '符号なしでの処理
     Else
         Debug.Print "入力値(符号なし): " & ans
         Debug.Print "2進数: " & Dta
         Debug.Print "16進数: " & smp2(Dta) & vbLf
   End If

End Sub

符号なし10進数を2進数/16進数に変換するサンプルコードに追加した内容としては、入力値に対する符号有無判定と符号有りでの計算用Function(smp4)の追加です。

Functionプロシージャは3つあり、smp2とsmp3は前投稿時と同様になります。今回は符号付き対応なので2の補数による変換処理用としてsmp4を追加した形となっています。

Function smp2(ByVal Dta As String) As String
'※※2進数⇒16進数変換処理を行う※※

   Dim TrDta, Db As String
   Dim i As Integer
 
   '受け渡された2進数文字列から半角スペースを除去
   Dta = Replace(Dta, " ", "")
  
   '2進数文字列データ数分繰り返し処理を実行
   For i = 1 To Len(Dta)
       '文字列内にコンマがある場合は変換したデータへ
       'コンマを連結し、次ループ処理を行う
       If Mid(Dta, i, 1) = "." Then
          TrDta = TrDta + "."
          GoTo Continue
        Else
          '文字列左端から1文字ずつ順に抜取り連結(変数Db)
          Db = Db + Mid(Dta, i, 1)
       End If
       
       '抜取り文字列数が4つ(4bit分)となる毎に以下Caseの
       '該当内容に応じて16進数文字列を変数TrDtaに格納
       If Len(Db) = 4 Then
         Select Case Db
           Case Is = "0000"
             TrDta = TrDta + "0"
           Case Is = "0001"
             TrDta = TrDta + "1"
           Case Is = "0010"
             TrDta = TrDta + "2"
           Case Is = "0011"
             TrDta = TrDta + "3"
           Case Is = "0100"
             TrDta = TrDta + "4"
           Case Is = "0101"
             TrDta = TrDta + "5"
           Case Is = "0110"
             TrDta = TrDta + "6"
           Case Is = "0111"
             TrDta = TrDta + "7"
           Case Is = "1000"
             TrDta = TrDta + "8"
           Case Is = "1001"
             TrDta = TrDta + "9"
           Case Is = "1010"
             TrDta = TrDta + "A"
           Case Is = "1011"
             TrDta = TrDta + "B"
           Case Is = "1100"
             TrDta = TrDta + "C"
           Case Is = "1101"
             TrDta = TrDta + "D"
           Case Is = "1110"
             TrDta = TrDta + "E"
           Case Is = "1111"
             TrDta = TrDta + "F"
         End Select
         Db = ""
       End If

Continue:

   Next i
   '処理完了後、実行元プロシージャへ値を返す
   smp2 = TrDta

End Function

Function smp3(ByVal cnt As Long) As Long
'※※桁合わせ処理用※※

    Dim lcnt As Long

    '受け渡された数値を元に桁合わせ必要数を設定
    Select Case cnt
      Case Is < 8
        lcnt = 8 - cnt
      Case Is < 16
        lcnt = 16 - cnt
      Case Is < 24
        lcnt = 24 - cnt
      Case Is < 32
        lcnt = 32 - cnt
      Case Is < 64
        lcnt = 64 - cnt
    End Select
  
    '処理完了後、実行元プロシージャへ値を返す
    smp3 = lcnt

End Function

◆2の補数によるマイナス変換処理(Function smp4)

Function smp4(ByVal Dta As String) As String
'符号付きの為、2の補数によりマイナス変換処理を行う
   
   Dim cnt, Arr_cnt As Long
   Dim n, quot, tcnt As Long
   Dim binD(1 To 17) As Variant  '4bit単位の格納配列
   Dim i As Integer
   Dim Db As String
   
   '引き渡された2進数データから空白削除
   Dta = Replace(Dta, " ", "")
   cnt = Len(Dta) '文字列数カウント
   
   '文字列数分繰り返して0⇔1反転の処理を行う
   For i = 1 To cnt
       '文字列内に含まれるカンマは単体で配列に格納し、
       '次処理に以降させる
       If Mid(Dta, i, 1) = "." Then
           Arr_cnt = Arr_cnt + 1
           binD(Arr_cnt) = "."
           GoTo Continue1
         Else
           '文字列左端から1文字ずつ順に抜取り反転して
           '変数Dbで連結させる
           Db = Db + CStr(1 - CInt(Mid(Dta, i, 1)))
       End If
       
       '抜き取った文字列数が4ヶとなる毎に配列へ格納
       If Len(Db) = 4 Then
           Arr_cnt = Arr_cnt + 1
           binD(Arr_cnt) = Db
           Db = ""
       End If
       '後で行う計算の便宜上、変数入れ替えの処理を行う
       tcnt = Arr_cnt
Continue1:
   Next i
   
Continue2:
   
   '対象配列の格納データが"."ではないことを確認する
   If binD(Arr_cnt) <> "." Then
       'Arr_cntが最終bitの配列を示すので、
       'その配列データを2進数⇒10進数に変換
       For i = 1 To 4
           n = n + (CInt(Mid(binD(Arr_cnt), i, 1)) _
           * 2 ^ (4 - i))
       Next i
     Else
       '対象配列が"."である場合は-1として再度処理を実行
       Arr_cnt = Arr_cnt - 1
       GoTo Continue2:
   End If
    
   '変換した10進数に1を加算
   n = n + 1
 
   Select Case n
     'nが15以下=繰り上がらない
     Case Is <= 15
       binD(Arr_cnt) = ""
       Do While n <> 0
           '10進数を再度2進数に変換
           quot = n \ 2
           binD(Arr_cnt) = binD(Arr_cnt) _
           + CStr(n Mod 2)
           '次計算用として変数numへ商を代入
           n = quot
       Loop
     
       '変換した2進数が4bitに満たない場合に0を付加
       If Len(binD(Arr_cnt)) < 4 Then
           Do
              binD(Arr_cnt) = binD(Arr_cnt) + "0"
           Loop Until Len(binD(Arr_cnt)) = 4
       End If
       
       '逆順に並び替え
       binD(Arr_cnt) = StrReverse(binD(Arr_cnt))
      
       '配列格納内のデータを全て連結し、メイン処理に返す
       '連結する際のカウントデータはtcntを使用する
       For i = 1 To tcnt
           Db = Db + binD(i) + Space(1)
       Next i
     
     Case Is > 15
       'nが15を超える場合は繰り上がるので、
       '当該配列は"0000"に置換
       binD(Arr_cnt) = "0000"
       
       '逆順で処理を行うのでArr_cntから-1として、
       '次ループ処理に移行
       If Arr_cnt <> 0 Then Arr_cnt = Arr_cnt - 1
       n = 0
       GoTo Continue2:
   End Select
   
   '処理完了後、実行元プロシージャへ値を返す
   smp4 = Db
   
End Function

ここでの処理は引き渡された2進数の各ビットを反転させ、4ビット毎に配列格納しながら10進数に変換して1を加算し、再度2進数に変換しています。

最終的に得た2進数のデータはメインプロシージャに戻り、結果出力と合わせてFunction smp2で16進数へ置換・ウィンドウへ出力しています。

無作為の10進数データで試算しながら変換結果の精度などを確認していますが、私が個人で使用している分には用を足せているので多少は使えそうな気がします。

3.まとめ

前回投稿した記事に追記として載せようかと思ったのですが、記事事態が非常に長くなり判り難い感じになったので敢えて別記事としてみました。



今回必要があって作成した次第なので私が試算している限りでは変換できているようですが、おそらくもっと確実で且つわかりやすい処理の仕方があるでしょうから、本サンプルは参考程度にみてもらえたらと思います。

以上、10進数(符号付き/小数点対応)を2進数/16進数へ変換するサンプルコードについてでした!今回の記事が何かの参考になれば幸いです。

Ryo

タイトルとURLをコピーしました