このような計算はできるでしょうか？

現在
「２バイトの数値」から「ビットが１である数」を求める
計算を行おうと思っています。

例えば、２バイトの数値が「２２２」の場合
→ビットに直すと「１１０１１１１０」となり
→ビットが１である数は「６」となります。

この計算をVBで行いたいのですが、
効率的に行える方法はないでしょうか？

AND演算を行い１ビットずつカウントすると
いう方法を考えたのすが、判定の時IF文がはいってしまうため
処理速度が遅くなり、困っております。

どなたか、お気づきの方はご教授ください。

No.1 ベストアンサー 回答者： maruru01 回答日時： 2003/10/24 12:14

こんにちは。

maruru01です。

ちょっと強引な方法ですが。
処理速度は確かめていません。


Dim temp As Long
Dim tempOct As String
Dim i As Long
Dim cnt As Long

temp = 222
tempOct = Oct(temp)
cnt = 0
For i = 1 To Len(tempOct)
　　cnt = cnt + CLng(Mid("01121223", Mid(tempOct, i, 1) + 1, 1))
Next i
MsgBox cnt

No.7 回答者： imogasi 回答日時： 2003/10/25 07:42

教科書に書いてある１０進－＞２進変換の通常方法の、２で割る方法はダメですか。

エクセルＶＢＡでテストしました。カウントする変数にn Mod 2が１であれば１を足せば良いのでは。これだと判ってるわいといわれそうですが。
技術計算や数値解析の繰り返し計算の膨大なルーチンですか。「判定の時IF文がはいってしまうため処理速度が遅くなり」－今時のコンピューターで信じられない。
Sub test01()
n = Cells(1, 1)
s = "" '２進数文字列を表示するため
b = 0 '１のビットの数
For i = 1 To 16
If (n Mod 2) = 1 Then b = b + 1
s = (n Mod 2) & s
n = Int(n / 2)
If n < 2 Then GoTo p01
Next i
p01:
If (n Mod 2) = 1 Then b = b + 1
s = (n Mod 2) & s
MsgBox s
MsgBox b
End Sub

この回答へのお礼

お礼が遅れて申し訳ございません。
皆様にまとめてお礼を申し上げさせていただきます。
たくさんの方から回答いただき感激です。
大変参考になりました。

ありがとうございます。

お礼日時：2003/10/27 10:39

No.6 回答者： todo36 回答日時： 2003/10/24 15:04

あ、2byte整数ね。

Private Declare Sub MoveMemory Lib "kernel32.dll" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)

Function BitCnt(ByVal intVal As Integer) As Long

Dim Cnt As Long
Dim lngVal As Long

Call MoveMemory(lngVal, intVal, 2) 'int型をlong型にキャスト

Do While lngVal
Cnt = Cnt + (lngVal And 1)
lngVal = lngVal \ 2
Loop
BitCnt = Cnt
End Function

No.5 回答者： todo36 回答日時： 2003/10/24 14:45

bitシフトもどきの

n = n \ 2
を使う。
最上位bitをマスクする必要がある。


Function BitCnt(ByVal n As Long) As Long

Dim Cnt As Long
If (n And &H80000000) Then
Cnt = 1
n = (n And &H7FFFFFFF)
End If
Do While n
Cnt = Cnt + (n And 1)
n = n \ 2
Loop
BitCnt = Cnt
End Function

# int型で扱うよりはlong型のほうが早いかも

No.4 回答者： terra5 回答日時： 2003/10/24 14:16

0～65535までの入力の場合

i = (i And &HAAAA) / 2 + (i And &H5555)
i = (i And &HCCCC) / 4 + (i And &H3333)
i = (i And &HF0F0) / 16 + (i And &HF0F)
i = (i And &HFF00) / 256 + (i And &HFF)

アセンブラ向きです。
本来は割り算でなくシフト演算使いますが、.NET以降でないと使えないようでしたので。

最初の式が一回の足し算で実質的に八回の足し算をおこなっているのがポイントです。
これは最初は1bit + 1bit = 2bitとなる計算なので
16bit幅があると2bitの演算を8つ分しています。
次は 2bit + 2bit = 4bit (3bitで十分ですが)
以下同様

条件分岐無し、データのメモリアクセス無し、加算、and、シフトは通常アセンブラ最速の命令ということで、
アセンブラレベルならこの手の方法が多分最速です。
VBだとよくわかりませんが、速い事は確かでしょう。

以前、32bit版をCで使いました。

No.3 回答者： bikkuri 回答日時： 2003/10/24 13:28

処理速度最優先で何回も行うのでしたら、表引きがいいです。

２バイトの値→ビット１の個数の表をあらかじめ
配列で作成しておき、単純に表を参照するだけです。

実際には、２バイト用の表は結構大きいので、１バイト用の
表を作成して、上位バイト、下位バイトで２回参照するのが
お勧めかもしれません。
（#1の方のも３ビット毎の表引きですね）

実装の例（動作未確認）
private bittab(255) as integer

public function bitcount(byval a as long) as integer
・bitcount = bittab(a mod 256) + bittab(a \ 256)
end function

bitcountを使用する前に、bittab()に0～255まで答えを
初期値として設定しておく必要があります。
（初期値を計算する方法は、従来のシフトなど好きな処理で）

No.2 回答者： FlossenEngel 回答日時： 2003/10/24 13:22

好ましいやり方ではないけれども、IFは使いません。

Dim lngTarget As Long
Dim lngResult As Long

lngResult = ((lngTarget And &H1) <> 0) _
+ ((lngTarget And &H2) <> 0) _
+ ((lngTarget And &H4) <> 0) _
+ ((lngTarget And &H8) <> 0) _
+ ((lngTarget And &H10) <> 0) _
+ ((lngTarget And &H20) <> 0) _
+ ((lngTarget And &H40) <> 0) _
+ ((lngTarget And &H80) <> 0) _
+ ((lngTarget And &H100) <> 0) _
+ ((lngTarget And &H200) <> 0) _
+ ((lngTarget And &H400) <> 0) _
+ ((lngTarget And &H800) <> 0) _
+ ((lngTarget And &H1000) <> 0) _
+ ((lngTarget And &H2000) <> 0) _
+ ((lngTarget And &H4000) <> 0) _
+ ((lngTarget And &H8000) <> 0)

Debug.Print lngResult / (True)

もうひとつ、あらかじめテーブルを用意しておくやり方も。

Dim lngTarget As Long
Dim intBits(256) As Integer

intBits(0) = 0
intBits(1) = 1
intBits(2) = 1
intBits(3) = 2
'...略
intBits(255) = 8

lngTarget = lngTarget And &HFFFF&
Debug.Print intBits(lngTarget \ 256) + intBits(lngTarget Mod 256)