• 締切済み

10進を2進(32ビット)に変換

VB2008を使っています。 10進を2進(16ビット)に変換するプログラムがあったので、 それを利用して32ビット対応にしたいのですが、 以下のプログラムの☆☆の位置でオーバーフローが発生してしまします。解決法をぜひ教えてください!! wave1は配列で、数字データが格納されています。 100 29584 12 489 : ここで、このデータを2進(32ビット)に変換し、 wave2という新しい配列に格納したいです。 Public Class Form1 (一部省略)   Const WD As Long = 300000 Private wave1(WD) As Integer   Private wave2(WD) As Long (一部省略) For i = 0 To 10 dec2bit = dec(wave1(i)) ☆☆ここでオーバーフロー発生 wave2(i) = dec2bit Next Private Function dec(ByRef decNum0 As Integer) Dim i As Integer Dim ret As Long Dim decNum As Long Dim dec2bit As String If decNum0 >= 0 Then '正、0はそのままセット decNum = decNum0 Else '負のときは、そのビットイメージをセット(例-1なら4294967296) decNum = 4294967296 + decNum0 End If dec2bit = "" '文字列を作成 For i = 1 To 32 '最上位ビット(最も左側のビット)が1か0か判定 ret = decNum And 2147483648 '2147483648は符号無しの&H80000000に相当 If ret <> 0 Then dec2bit = dec2bit & "1" Else dec2bit = dec2bit & "0" End If '左へ1ビットシフトする 'シフト演算子 decNum = decNum << 1 'オーバーフロー防止 If decNum >= 4294967296 Then decNum = decNum - 4294967296 End If Next Return dec2bit End Function End Class

みんなの回答

回答No.1

'残念ながらエラーが再現できない。正常に動作する。(試した範囲ではConvert.toStringと同じ値を返している) '以下のソースは質問文のものから多少改変している。 Option Explicit On Option Strict On Option Compare Binary 'Option Infer Off Class Q4671082A Public Shared Function dec(ByVal decNum0 As Integer) As String Dim dec2bit As String Dim decNum As Long Dim ret As Long If decNum0 >= 0 Then '正、0はそのままセット decNum = decNum0 Else '負のときは、そのビットイメージをセット(例-1なら4294967296) decNum = decNum0 + 4294967296 End If dec2bit = "" '文字列を作成 For i As Integer = 1 To 32 '最上位ビット(最も左側のビット)が1か0か判定 ret = decNum And 2147483648 '2147483648は符号無しの&H80000000に相当 If ret <> 0 Then dec2bit = dec2bit & "1" Else dec2bit = dec2bit & "0" End If '左へ1ビットシフトする 'シフト演算子 decNum = decNum << 1 'オーバーフロー防止 If decNum >= 4294967296 Then decNum = decNum - 4294967296 End If Next Return dec2bit End Function Shared Sub Main() Dim fuga As Q4671082A fuga = New Q4671082A() System.Console.WriteLine(Q4671082A.dec(Integer.MaxValue)) System.Console.WriteLine(System.Convert.ToString(Integer.MaxValue,2).PadLeft(32,"0"c)) System.Console.WriteLine(Q4671082A.dec(29584)) System.Console.WriteLine(System.Convert.ToString(29584,2).PadLeft(32,"0"c)) System.Console.WriteLine(Q4671082A.dec(-29584)) System.Console.WriteLine(System.Convert.ToString(-29584,2).PadLeft(32,"0"c)) System.Console.WriteLine(Q4671082A.dec(Integer.MinValue)) System.Console.WriteLine(System.Convert.ToString(Integer.MinValue,2).PadLeft(32,"0"c)) 'キーボード入力待ち System.Console.ReadKey(True) ’質問文ではString型のものをLong型に代入しているが,これは避けたい。 'というか、そこだけは、何をやろうとしているのかさっぱり判らん。 End Sub End Class

関連するQ&A

  • 文字型変数を使って2進数表示すると、最上位ビットに1を立てると値に-記号が入ってしまいます

    VB6.0 WindowsXP 掲題の件ですが以下のコードを使って16進数を2進数表示にしていますが、最上位ビットに1を立てると値がおかしくなってしまいます。 Private Sub Form_Load() Dim dat(5) As Variant Dim i As Variant dat(0) = Right("0000000000000000" & Hex2Bin(Hex(&HFFFF)), 16) dat(1) = Right("0000000000000000" & Hex2Bin(Hex(&HFFFE)), 16) dat(2) = Right("0000000000000000" & Hex2Bin(Hex(&HFF00)), 16) dat(3) = Right("0000000000000000" & Hex2Bin(Hex(&HF000)), 16) dat(4) = Right("0000000000000000" & Hex2Bin(Hex(&HF0F0)), 16) dat(5) = Right("0000000000000000" & Hex2Bin(Hex(&H7FFF)), 16) For i = 0 To 5 Label1.Caption = Label1.Caption & dat(i) & vbCrLf Next Label2.Caption = "FFFF" & vbCrLf & "FFF0" & vbCrLf & "FF00" & vbCrLf & "F000" & vbCrLf & "F0F0" End Sub Public Function Hex2Bin(Hex) Dim Dec Dec = CInt("&H" + Hex) Hex2Bin = Dec2Bin(Dec) End Function Public Function Bin2Hex(Bin) Dim Dec Dec = Bin2Dec(Bin) Bin2Hex = Hex(Dec) End Function Public Function Dec2Bin(ByVal Dec) Do Dec2Bin = CStr(Dec Mod 2) & Dec2Bin Dec = Dec \ 2 Loop Until Dec = 0 End Function Public Function Bin2Dec(Bin) Dim i As Integer For i = 1 To Len(Bin) Bin2Dec = Bin2Dec * 2 + CInt(Mid(Bin, i, 1)) Next End Function なぜこうなってしまうのか、最上位に1を入れても1000000000000 のように表示させるにはどうしたらよいか教えていただきたいです。 よろしくお願いします。

  • Excel2000のVBAでわからないことがあります。

    こんなものを作ってみました。 Sub 理想体重() Dim Sin As Long Dim Tai As Long Sin = InputBox("あなたの体重は?", "体重") Tai = InputBox("あなたの身長は?", "身長") If Tai >= Sin * Sin * 21 / 10000 + 3 Then MsgBox "太りすぎです" ElseIf Tai <= Sin * Sin * 21 / 10000 - 3 Then MsgBox ("痩せすぎです") Else MsgBox ("標準です") End If End Sub 結果はきちんと出てくるのですが、最初の変数宣言のところがわかりません。 最初は、Longではなく、Integerにしたのですが、オーバーフローのエラーが出たので、Longに変更したところ、きちんと出てくるようになりました。 しかし、なぜ、Integerではだめなのかがわかりません。私としては、Integerは32,767までの数字が入るのだから、身長や体重を入れたぐらいだと、オーバーフローにはならないのではないかと考えています。 きっと、根本的なものがわかっていないんだとは思うのですが、違いを教えていただければうれしいです。 よろしくお願いいたします。 (VBAを勉強したばかりです。)

  • 「'」もascで変換させたい

    A1に「'test」と入れると「test」になってしまいます。 そして、 Sub test() Dim MojiInt As Long Dim i As Long Dim myRow As Long Dim Moji As String MojiInt = Len(Cells(1, 1)) For i = 1 To MojiInt Moji = Mid((Cells(1, 1)), i, 1) If i = 1 Then Cells(1, 2) = Asc(Moji) Else Cells(1, 2) = Cells(1, 2) & "," & Asc(Moji) End If Next i End Sub をすると、 116,101,115,116 になります。 最初の「'」もascで変換させることは無理なのでしょうか?

  • シリアル通信:オフライン時にうまく終了してくれません

    シリアルプリンタの制御をVB6で行っております。 以下のようなコードですが、うまく終了してくれません。 'グローバル 'プリンタの状態 Dim BUF as String '起動時 Private Sub Form_Load() MSComm1.PortOpen = True Text1.Text = "" Timer1.Enabled = True End Sub '終了 Private Sub Form_Unload(Cancel As Integer) Timer1.Enabled = False MSComm1.PortOpen = False End Sub 'タイマー Private Sub Timer1_Timer() Timer1.Enabled = False Call CheckPrint Timer1.Enabled = True End Sub Private Sub MSComm1_OnComm() Dim TimeOut As Long Dim sTime As Long Dim eTime As Long Select Case MSComm1.CommEvent '受信 Case comEvReceive TimeOut = 100 sTime = timeGetTime Do If (TimeOut - eTime) < 0 Then Exit Do End If eTime = (timeGetTime - sTime) Loop Until MSComm1.InBufferCount >= 82 BUF = MSComm1.Input End Select End Sub プリンタの状態チェック Private Sub CheckPrint() Dim sTime As Long Dim eTime As Long Dim TimeOut As Long Dim i As Integer Dim n As Integer BUF = "" 'プリンタの情報取得コマンド MSComm1.Output = "~HS" 'タイマ開始 TimeOut = 400 sTime = timeGetTime eTime = 0 Do DoEvents If BUF <> "" Then Exit Do End If eTime = (timeGetTime - sTime) Loop Until TimeOut - eTime < 0 If BUF <> "" Then ... .. 宜しくお願いします。

  • macroについて教えてください

    こんにちは。以前こちらでPrivate SubについてMacroを教えていただきました。(あの後ログインパスワード等が不明になりお礼も出来ませんでしたが。。。回答頂いた方すみませんでした。) 下記がそのMacroですが、今回また少し変えることになり どのように変えていいのか分かりません。 前回は1~5はグレー、6~10は茶色・・・という形にしたのですが 今回は進捗率での管理をしたく、80%以下は白、80~90%は赤、90~100%は青としたいと思っています。 Private Sub Worksheet_Change(ByVal Target As Range) Dim iColors As Variant Dim rw As Long Dim CellCnt As Integer Dim col As Integer Dim col2 As Integer Dim i As Integer Dim j As Integer Dim k As Integer Dim c As Variant Dim ar() As Variant Dim Sh1 As Worksheet Set Sh1 = Worksheets("小児科Dr") col = Target.Cells(1).Column '制限された列 If Not (col = 4 Or col = 8 Or col = 12 Or col = 16) Then Exit Sub iColors = Array(16, 16, 16, 16, 16, 53, 53, 53, 53, 53, 54, 54, 54, 54, 54) CellCnt = Target.Count ReDim ar(CellCnt - 1) For Each c In Target If c.Value <> "" Then If IsNumeric(c.Value) Then i = c.Value If i >= 11 Then i = 10 End If If i > 0 And i < 11 Then j = iColors(i - 1) Else j = 2 End If ar(k) = j k = k + 1 End If End If Next c rw = Target.Row Select Case col Case 4: col2 = 2 Case 8: col2 = 8 Case 12: col2 = 14 Case 16: col2 = 20 'Sh1.Cells(rw + 2, 13).Resize(Int(Target.Count / 3), 3).Interior.ColorIndex = j End Select InsideColors Sh1, rw, col2, CellCnt, ar() Set Sh1 = Nothing End Sub Private Sub InsideColors(sh As Worksheet, _ rw As Long, _ col As Integer, _ cnt As Integer, _ ar As Variant) 'sh[シート],rw[行], col[列],cnt[セル個数],iColor[色指数] Dim i As Integer Dim j As Integer Dim n As Integer Dim k As Integer If cnt Mod 5 > 0 Then '範囲行数 i = (cnt + 5 - (cnt Mod 5)) / 5 Else i = cnt / 5 End If rw = Int((rw - 1) / 5) + 1 '行再設定 j = ((rw - 1) Mod 5) + 1 '列設定 For n = j To cnt sh.Cells(rw + 2, col).Resize(i, 5).Cells(n).Interior.ColorIndex = ar(k) k = k + 1 Next n End Sub 毎回他の人を頼ってしまい、申し訳ないのですがお願いします。 また、前回分からなかったので1~5を指定するときに5回同じカラー番号を書いたのですがこちらも良かったら手直し方法を教えていただければ助かります。 宜しくお願いします。

  • 検索 マクロ

    本を見ながら作ったのですが 検索してくれるのですが A列を検索してくれるのですが検索したいのは B列の4番目から下にあるだけ検索したいのですが どういじればいいのでしょうか? Option Explicit Private lastRow As Long Private Index As Integer Private Sub UserForm_Activate() Dim i As Long lastRow = Worksheets("顧客情報").Cells(Rows.Count, 1).End(xlUp).Row + 1 If lastRow <= 3 Then MsgBox "データがありません。" Exit Sub End If For i = 3 To lastRow 名前リストボックス.AddItem Cells(i, 1) Next End Sub Private Sub 検索ボタン_Click() Dim searchName As String searchName = 検索名前テキストボックス.Text If searchName = "" Then MsgBox "検索する名前を入力してください。" Else Dim i As Long Dim no As Long For i = 0 To 名前リストボックス.ListCount - 1 If 名前リストボックス.List(i) = searchName Then no = i 名前リストボックス.ListIndex = no Exit For ElseIf i >= 名前リストボックス.ListCount - 1 Then MsgBox "該当なし。" Exit For End If Next Index = no + 3 Rows(Index).Select End If End Sub

  • エラー:ストリームの終わりを超えて読み取ることはできません

    VB2008を使い始めたばかりの初心者です。 以下のようなプログラム(一部省略)で、ちょうど下から5行目くらいの 「右CHを最大個数まで読む」の行がエラーがでてしまいます。すぐ上の「左CHを最大個数まで読む」ではエラーはでません。 原因が分からないため、教えてください!! WAVEファイルを読み込むプログラムです。 最大数を3000として考えています。 WAVEファイルは音声ファイルで、構成は以下のようになっています。 RIFF:4バイト サイズ:4バイト WAVE:4バイト fmt:4バイト fmtチャンクのデータ:20バイト←上の12バイトは読まなくて良いため、hdp=13としてここから読みはじめています data:4バイト dataサイズ:4バイト dataチャンクのデータ:ここが読み取りたい音声にあたるデータ また、WAVEファイルはステレオで、2チャンネルあり、実際の音データは(dataチャンクのデータ)左、右・・・と交互に入っています。 ---------------------------------------------------------------------- Const WD As Short = 30000 '最大のデータ数30000 Private l_wave(WD) As Integer '左チャンネルのデータ配列 Private r_wave(WD) As Integer '右チャンネルのデータ配列 Private dmax As Integer 'データ数の最大値 Private filename As String 'ファイル名 Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer     '-------ファイルを開く------------------------------------------------- OpenFileDialog1.Filter = "waveファイル(*.wav)|*.wav" If OpenFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then filename = OpenFileDialog1.FileName Else Exit Sub End If     '----------------------------------------------------------------------  Dim hID As New VB6.FixedLengthString(4) 'チャンクID、4文字分 Dim hdsize As Integer 'チャンクサイズ Dim hdp As Integer 'ポインタ=チャンクの位置 Dim fsize As Integer Dim i As Object dmax = WD '最大データ個数 fsize = FileLen(filename) 'ファイルサイズの取得 hdp = 13 'fmtチャンクの位置 FileOpen(1, filename, OpenMode.Binary) 'ファイルをバイナリモードで開く '****************ファイルの終わりまで繰り返す*********************************** Do Until hdp >= fsize FileGet(1, hID.Value, hdp) 'チャンクHIDの種類の取得 FileGet(1, hdsize)     'チャンクのサイズの取得              '------チャンクIDがfmtならその位置をIntegerで返す--------------------- If InStr(hID.Value, "fmt") Then TextBox1.Text = hID.Value FileGet(1, wavfmt) End If       '---------------------------------------------------------------------       '------チャンクIDがdataならその位置をIntegerで返す--------------------- If InStr(hID.Value, "data") Then TextBox1.Text = TextBox1.Text & vbCrLf & hID.Value   For i = 0 To 10 FileGet(1, l_wave(i)) '左chデータを最大個数まで読む FileGet(1, r_wave(i)) '右chデータを最大個数まで読む ***エラー箇所*** Next   End If       '----------------------------------------------------------------------- hdp = hdp + hdsize + 8       '次のチャンクへ8バイトポインタ移動 Loop '******************************************************************************** 

  • ExcelVBAでのkernel32(64bit)

    今までExcel2000のVBAから、以下のようなコードを使ってC++で作ったコマンドプロンプトで動くプログラムを動かすプログラムを作っていましたが、これを64bitのWindows7上で動いているExcel2010で使おうとしたらメッセージが出ました。いろいろ調べてみたところ、たぶんDeclareにPtrSafeを付ければ良いようなのですが、その際、他のコードはそのままで良いのでしょうか。特に、コード中のLongはそのままで良いのか気になるのですが...。ちなみに、下記コードの条件コンパイルはネットで調べて見よう見まねで付けたもので、Excel2000のときには付けていないものでした。ご存じの方がいらっしゃいましたらご教授ください。 '------------------------------------------------------------------------------ ' Win32 API関数・定数の宣言 '------------------------------------------------------------------------------ #If VBA7 And Win64 Then '64bit Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _   ByVal dwMilliseconds As Long) As Long Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _   ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long #Else '32bit Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _   ByVal dwMilliseconds As Long) As Long Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _   ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long #End If Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF Private Const INFINITE As Long = &HFFFF '------------------------------------------------------------------------------ ' Run '------------------------------------------------------------------------------ Public Sub Run(ByVal project_name As String)   Dim program As String   Dim task_id As Long   Dim h_proc As Variant   program = mdlFunc.ProgramPath() & mdlFunc.ProgramOption(project_name) 'プログラム名   task_id = Shell(program, vbHide)   h_proc = OpenProcess(PROCESS_ALL_ACCESS, False, task_id)   If OpenProcess(PROCESS_ALL_ACCESS, False, task_id) <> vbNull Then     Call WaitForSingleObject(h_proc, INFINITE)     CloseHandle h_proc   End If End Sub

  • マクロ 修正 (初心者です)

    Option Explicit Private lastRow As Long Private Index As Integer Private Sub CommandButton1_Click() Unload Me End Sub Private Sub あいまいボタン_Click() Dim last As Long If 検索名前テキストボックス.Text = "" Then MsgBox "あいまい抽出する名前を入力してください。" Exit Sub End If last = Range("A500").End(xlUp).Row Range("A2:D" & last).AutoFilter Field:=2, Criteria1:="=*" & 検索名前テキストボックス.Text & "*" End Sub Private Sub UserForm_Activate() Dim i As Long lastRow = Worksheets("顧客情報").Cells(Rows.Count, 1).End(xlUp).Row + 1 If lastRow <= 3 Then Exit Sub End If For i = 4 To lastRow 名前リストボックス.AddItem Cells(i, 2) Next End Sub Private Sub 検索ボタン_Click() Dim searchName As String searchName = 検索名前テキストボックス.Text If searchName = "" Then MsgBox "検索する名前を入力してください。" Else Dim i As Long Dim no As Long For i = 0 To 名前リストボックス.ListCount - 1 If 名前リストボックス.List(i) = searchName Then no = i 名前リストボックス.ListIndex = no Exit For ElseIf i >= 名前リストボックス.ListCount - 1 Then MsgBox "該当なし。" Exit For End If Next Index = no + 3 Rows(Index).Select End If End Sub B列に名前を入力しています B3から検索してくれるマクロを作成しました(インターネット見ながら) 別の検索も作りたくてどこをいじればいいのかわからず書き込みました G3列(住所を検索)から下側を検索したいのですがどこをいじればいいでしょうか?

  • Workbook

    次のプログラムをExcelのWorkbookで開くやり方がよくわかりません。 どうやってやるのか教えていただけないでしょうか? Option Explicit Const ALIVE As Integer = 1 Const DEAD As Integer = 0 Const BORN As Integer = 3 Const LIFE As Integer = 2 Const SIZE As Integer = 20 Const Tmax As Integer = 100 Dim C(SIZE, SIZE) As Integer Dim Xrange As Variant Private Sub LifeGame() Dim InitRate As Single Dim T As Integer Dim I As Integer, J As Integer Randomize Xrange = Range("A1:T20") InitRate = 0.5 For I = 1 To SIZE For J = 1 To SIZE If Rnd() < InitRate Then C(I, J) = ALIVE Else C(I, J) = DEAD End If Next J Next I For T = 1 To Tmax For I = 1 To SIZE For J = 1 To SIZE If C(I, J) = ALIVE Then Xrange(I, J) = "■" Else Xrange(I, J) = "" End If Next J Next I Range("A1:T20") = Xrange For I = 1 To SIZE For J = 1 To SIZE C(I, J) = Cnext(I, J) Next J Next I Next T End Sub Function Cnext(I As Integer, J As Integer) As Integer Dim xi As Integer Dim xj As Integer Dim xsum As Integer For xi = I - 1 To I + 1 For xj = J - 1 To J + 1 If (xi > 0 And xi <= SIZE) _ And (xj > 0 And xj <= SIZE) Then If Not (xi = I And xj = J) Then If C(xi, xj) = ALIVE Then xsum = xsum + 1 End If End If End If Next Next Select Case xsum Case BORN Cnext = ALIVE Case LIFE Cnext = C(I, J) Case Else Cnext = DEAD End Select End Function Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Call LifeGame End Sub