有効桁数1桁の16進数電卓をExcelVBAで作る （×÷編）

前回の＋－の続きです。

算出方法②

掛け算
　C5セル　×
　結果セル範囲　D12:E251のデータを削除
　結果0のC26セルへ　アクティブセル移動
　入力値1個　下へ　　アクティブセル移動を　入力値2個繰り返す
割り算
　C5セル　÷
　結果セル範囲　D12:E251のデータを削除
　結果0のC26セルへ　アクティブセル移動
　余り用変数に0を設定しておく
　0からFまでの配列を入力値1になるまで下記の処理繰り返す
　　入力値1なれば処理終了結果表示
　　入力値2と余り用変数+1が等しければ
　　　アクティブセル　1つ下に移動
　　　余り用変数を0にする
　　違う場合は余り用変数+1
※入力値2と余り用変数+1を比較するのは
　繰り返しの次の入力値1との配列の値の比較で結果表示するからです。
　入力値2と余り変数の比較を先にしてしまうと、
　入力値1が0の際の結果に対応するためです。　　

ワークシートにコード入力②

+-編と重複したサブルーチンも載せています。

Private Const HEXADECIMAL As String = "0,1,2,3,4,5,6,7,8,9,A,B,C,D,E"  '16進数'
Private Const RANGE_NUM1 As String = "B5"            '数字1 セル位置'
Private Const RANGE_NUM2 As String = "D5"            '数字2 セル位置'
Private Const RANGE_OPERATOR As String = "C5"        '演算子 セル位置'
Private Const RANGE_RESULT_0 As String = "D26"       '結果の開始 セル位置'
Private Const RANGE_RESULT As String = "D11:E251"    '結果の範囲'

'掛け算'
Private Sub btnTimes_Click()
   
   Dim wArray As Variant
   Dim wNumber As Variant
   
   '結果部分を初期化'
   Call initResultArea("×")
   
   wArray = Split(HEXADECIMAL, ",")  '配列に0,1,...,F 格納'
   
   For Each wNumber In wArray
       
       '数字2になったら繰り返し終了'
       If Me.Range(RANGE_NUM2).Text = wNumber Then
           Exit For
       End If
       Call moveCell(Me.Range(RANGE_NUM1).Text, True)  '数字1　下へ　移動'
   
   Next
   
   '結果表示'
   ActiveCell.Value = "答え☆"

End Sub

'割り算'
Private Sub btnDivide_Click()

   Dim wArray As Variant
   Dim wlng_amari As Long    '余り用変数'
   Dim wNumber As Variant
   
   '結果部分を初期化'
   Call initResultArea("÷")
   
   wArray = Split(HEXADECIMAL, ",")
   wlng_amari = 0
   
   For Each wNumber In wArray
       
       '数字1になったら繰り返し終了'
       If Me.Range(RANGE_NUM1).Text = wNumber Then
           Exit For
       End If
          
       '数字2になったら結果セルを下に1つ移動 余りを0にする'
       If Me.Range(RANGE_NUM2).Text = wlng_amari + 1 Then
           Call moveCell(1, True)
           wlng_amari = 0
       Else
           wlng_amari = wlng_amari + 1
       End If
  
   Next
   
   '結果表示'
   ActiveCell.Value = "答え☆"
   ActiveCell.Offset(0, 1).Value = "余り" & wlng_amari

End Sub

'結果範囲を初期化する'
Private Sub initResultArea(ByVal hstr_ope As String)
   
   Me.Range(RANGE_OPERATOR).Value = hstr_ope
   Me.Range(RANGE_RESULT).Delete
   Me.Range(RANGE_RESULT_0).Activate
   
End Sub

'ActiveCellを移動する'
Private Sub moveCell(ByVal hstr_number As String, _
                    ByVal hbln_Down As Boolean)
   
   Dim wArray As Variant
   Dim wNumber As Variant
   
   wArray = Split(HEXADECIMAL, ",")
   
   For Each wNumber In wArray
       
       If hstr_number = wNumber Then
           Exit For
       End If
       If hbln_Down Then
           ActiveCell.Offset(1, 0).Activate
       Else
           ActiveCell.Offset(-1, 0).Activate
       End If
   
   Next

End Sub

結果表示

まとめ

電卓1桁だったら簡単かなと思ったのですが、
割り算は数えるだけで結果を考えるのが難しかったです。
For文の練習としては良いかなと思いました。