SSブログ

トロPのVBAホビラボ 32ビット符号無し整数 その1 [トロPのVBAホビラボ]

今回は文字列から離れて整数です。

VBAの整数型には次の3種類があります。

  • 符号無し8ビット整数型Byte
  • 符号付き16ビット整数型Short
  • 符号付き32ビット整数型Long

符号無し整数型はあるにはあるのですが、0から255の範囲しか表せません。
日常的な計算に使うには少しサイズが小さすぎますね。

Windows APIをお使いになる方でしたら、やはり32ビットが一番利用する
のではないでしょうか。

4つの要素を持つByte型の配列を使うという手もありますが、扱いが面倒です。

そこで今回から、Longを符号無し32ビット整数型として扱うための
ユーティリティーを作っていきましょう。

数値ですので、四則演算は当然のこと、文字表現や大小比較も作って
おきたいですね。

通常の演算子はまともに使えませんので、より基本的な演算であるビット演算子で
考えていきましょう。

ビットの取り出し

まず、特定のビットだけ取り出す方法を用意しましょう。
取り出すとはいっても結果はLong型のまま。
実際には指定位置以外のビットを全て0にすることで十分でしょう。

指定位置のビットが1で、他のビットが全て0の数作れば、
この数とのAndをとることで実現できます。

ここでは、その数を作る関数を示します。
まだ演算の実現に取り掛かっていませんので、あえて鈍くさく、リテラルで返していきます。

サンプル
Public Function LngBitXtrVal(ByVal Bit As Long) As Long

    Dim l_BitXtrVal As Long

    Select Case Bit
    Case 1
        l_BitXtrVal = 1&
    Case 2
        l_BitXtrVal = 2&
    Case 3
        l_BitXtrVal = 4&
    Case 4
        l_BitXtrVal = 8&
    Case 5
        l_BitXtrVal = &H10&
    Case 6
        l_BitXtrVal = &H20&
    Case 7
        l_BitXtrVal = &H40&
    Case 8
        l_BitXtrVal = &H80&
    Case 9
        l_BitXtrVal = &H100&
    Case 10
        l_BitXtrVal = &H200&
    Case 11
        l_BitXtrVal = &H400&
    Case 12
        l_BitXtrVal = &H800&
    Case 13
        l_BitXtrVal = &H1000&
    Case 14
        l_BitXtrVal = &H2000&
    Case 15
        l_BitXtrVal = &H4000&
    Case 16
        l_BitXtrVal = &H8000&
    Case 17
        l_BitXtrVal = &H10000
    Case 18
        l_BitXtrVal = &H20000
    Case 19
        l_BitXtrVal = &H40000
    Case 20
        l_BitXtrVal = &H80000
    Case 21
        l_BitXtrVal = &H100000
    Case 22
        l_BitXtrVal = &H200000
    Case 23
        l_BitXtrVal = &H400000
    Case 24
        l_BitXtrVal = &H800000
    Case 25
        l_BitXtrVal = &H1000000
    Case 26
        l_BitXtrVal = &H2000000
    Case 27
        l_BitXtrVal = &H4000000
    Case 28
        l_BitXtrVal = &H8000000
    Case 29
        l_BitXtrVal = &H10000000
    Case 30
        l_BitXtrVal = &H20000000
    Case 31
        l_BitXtrVal = &H40000000
    Case 32
        l_BitXtrVal = &H80000000
    Case Else
        Err.Raise 9001, , "The specified bit is out of range from 1 to 32."
    End Select

    LngBitXtrVal = l_BitXtrVal

End Function

しつこく付いている「&」はLong型であることを示すサフィクスです。
このサフィクス付けない場合、16ビットに収まる範囲の数はInteger型のように
扱われます。

具体的には&H8000~&HFFFFは負数となってしまい、具合が悪くなります。
型サフィクスは慎重につけていきましょう。

加算

各桁の演算結果は、その桁の値とキャリーの値の2つになります。
また、2進数では、被加数、加数、キャリーはそれぞれ0または1をとり得ます。

その桁の値の方は、1が0個か2個なら0、1個か3個なら1です。
1になる場合は、0個か2個より1個多いと言い換えられます。
ということは、2個が一致して、残りの1個が1の場合です。

これを論理式で表すと、

(被加数 And (Not (加数 Xor キャリー))) Or
(加数 And (Not (被加数 Xor キャリー))) Or
(キャリー And (Not (被加数 Xor 加数)))

上の桁へのキャリーは、1が2個未満なら0、2個以上なら1です。
これはもう簡単に、いずれか2個が1であれば1でよいですね。

論理式で表すとこうなります。

(被加数 And 加数) Or (被加数 And キャリー) Or (加数 And キャリー)

下の桁からのキャリーも同様です。

これらを各桁で繰り返せばよいですが、各回でその桁だけに集中するために、
ここでは下からのキャリーを計算する方式で書いてみましょう。

最後に、一番上の桁を計算し終えた後、下の桁(つまり一番上の桁)からの
キャリーが1だったらオーバーフローと判定します。

ここのところは念のため、オーバーフローを許せるようにしておきましょう。
この場合、あふれた桁は無視することにします。

サンプル
Public Function ULngsSum _
    (ByVal Value1 As Long, ByVal Value2 As Long, _
    Optional ByVal Force As Boolean = False) _
As Long

    Dim l_Bit       As Long
    Dim l_BitXtrVal As Long
    Dim l_Carry     As Long
    Dim l_CurVal1   As Long
    Dim l_CurVal2   As Long
    Dim l_PrevVal1  As Long
    Dim l_PrevVal2  As Long
    Dim l_Sum       As Long
    
    l_Sum = 0&
    l_Carry = 0&
    l_PrevVal1 = 0&
    l_PrevVal2 = 0&
    
    For l_Bit = 1& To 32&

        l_BitXtrVal = LngBitXtrVal(l_Bit)

        l_CurVal1 = Value1 And l_BitXtrVal
        l_CurVal2 = Value2 And l_BitXtrVal

        If 0 <> ( _
            (l_PrevVal1 And l_PrevVal2) Or _
            (l_PrevVal1 And l_Carry) Or _
            (l_PrevVal2 And l_Carry) _
            ) Then
            l_Carry = l_BitXtrVal
        Else
            l_Carry = 0&
        End If

        If 0 <> ( _
            (l_CurVal1 And (Not (l_CurVal2 Xor l_Carry))) Or _
            (l_CurVal2 And (Not (l_CurVal1 Xor l_Carry))) Or _
            (l_Carry And (Not (l_CurVal1 Xor l_CurVal2))) _
            ) _
            Then l_Sum = l_Sum Or l_BitXtrVal

        l_PrevVal1 = l_CurVal1
        l_PrevVal2 = l_CurVal2

    Next l_Bit

    If Not Force Then

        If 0 <> ( _
            (l_PrevVal1 And l_PrevVal2) Or _
            (l_PrevVal1 And l_Carry) Or _
            (l_PrevVal2 And l_Carry) _
            ) Then Err.Raise 9002, , "An overflow has occurred."

    End If

    ULngsSum = l_Sum

End Function

指定位置のビットを取り出すために作ったLngBitXtrValですが、
単純に使うことでキャリーにもなりますね。

次回は、残りの演算等を順に用意していきましょう。


広告
nice!(0)  コメント(0)  トラックバック(0) 

nice! 0

コメント 0

コメントを書く

お名前:
URL:
コメント:
画像認証:
下の画像に表示されている文字を入力してください。

トラックバック 0

トラックバックの受付は締め切りました

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。