C言語の乱数発生方法をVBAで実装する方法

このQ&Aのポイント
  • C言語の乱数発生方法をVBAで実装する方法について質問があります。
  • 乱数の範囲は0.0から1.0までの一様乱数です。
  • VBAでのコードには若干の誤りがあり、修正方法について教えていただければと思います。
回答を見る
  • ベストアンサー

本に掲載されたC言語の乱数発生方法をVBAでかく方法が知りたいです.

本に掲載されたC言語の乱数発生方法をVBAでかく方法が知りたいです. 0.0から1.0までの一様乱数を発生させる方法です. C言語のコードは以下に載せます. #define IA 16807 #define IM 2147483647 #define AM (1.0/IM) #define IQ 127773 #define IR 2836 #define MASK 123459876 float ran0(long *idum) { long k;   float ans; *idum ^= MASK; k=(*idum)/IQ; *idum=IA*(*idum-k*IQ)-IR*k; if (*idum < 0) *idum += IM; ans=AM*(*idum); *idum ^= MASK; return ans; }  以下に自分でVBAでかいてみたコードを載せます. Sub 乱数発生() Const IA As Integer = 16807 Const IM As Long = 2147483647 Const AM = (1# / IM) Const IQ As Long = 127773 Const IR As Integer = 2836 Const MASK As Long = 123459876 Dim k As Long Dim ans As Single Dim idum idum = idum Xor MASK k = (idum) / IQ idum = IA * (idum - k * IQ) - IR * k If idum < 0 Then idum = idum + IM ans = AM * (idum) idum = idum Xor MASK End Sub  最初と最後のidum = の式の説明に排他的論理和をとるという説明が書いてあったので,^ではなくXorと書きました.これで一応ansは1より小さい数値がでましたが,C言語の数値と合いませんでした. プログラムのことはほとんどわからないので,教えて下さい. よろしくお願いします.

質問者が選んだベストアンサー

  • ベストアンサー
  • OXY23
  • ベストアンサー率36% (27/74)
回答No.1

こんばんは。 スレちがいな気がしますが、とりあえずコメントします。 質問者さんは、生成した乱数は、どんな環境でも同じ結果になると考えていませんか? ソースのほうはしっかり見ていませんが、乱数の出力値は、CとVBで異なるので、発生させた乱数の結果が異なるのは適切なのではないでしょうか?

jimysen
質問者

お礼

回答ありがとうございます. MASKに入れる数値を変えると乱数が初期化されると本に書いてあったので,その数値を変えない限りは生成される乱数の値は常に同じになると思いこんでいました. 教えて頂きありがとうございました.

関連するQ&A

  • ある乱数生成法により,生成した最初の乱数の値は固定するか確かめて頂きた

    ある乱数生成法により,生成した最初の乱数の値は固定するか確かめて頂きたいです. 0.0から1.0までの一様乱数を発生させる方法です. C言語のコードは以下に載せます. #define IA 16807 #define IM 2147483647 #define AM (1.0/IM) #define IQ 127773 #define IR 2836 #define MASK 123459876 float ran0(long *idum) { long k;   float ans; *idum ^= MASK; k=(*idum)/IQ; *idum=IA*(*idum-k*IQ)-IR*k; if (*idum < 0) *idum += IM; ans=AM*(*idum); *idum ^= MASK; return ans; } この乱数生成法をBVAで,計算の中で繰り返し用いようとしています. idumを任意の整数値に設定・再設定すれば乱数列が初期化されると書いてあったため,idumの値を変えてみましたが,生成された乱数の最初の値は固定されたままでした. そこで,もともとこの乱数生成法がそのようになっているのかを教えて頂きたいです. よろしくお願いします.

  • VBAでのORの使い方

    以下のようなVBAがあります。指定したフォルダーに保存されているエクセルのファイル名を取得するものです。 ここでやりたいのは、AとJPから始まるファイルを取得したいのですがうまくいきません。これですのコンパイルエラーが出ます。 どう変更すべきかご教示願います。 Sub ファイル名取得() Const SEARCH_DIR As String = "\\SOGKF01.JP.TakataCorp.com\XXXXXXXX\YYYYY" Const SEARCH_FILE As String = "AS*.xlsm" Or Const SEARCH_FILE As String = "JP*.xlsm" Dim tmpFile As String Dim strCmd As String Dim buf() As Byte Dim FileList() As String Dim myArray() As String Dim cnt As Long, pt As Long, i As Long 続く

  • VBAで、配列のデータをセルに書き戻す方法について

    1000行200列の配列があり、配列の5列目と6列目のデータを、セルの10列目と11列目にすばやく書き戻す方法を教えてください。 (方法1) Dim DATA() As Long ReDim DATA(1 To 1000, 1 To 200) FOR 行番号= 1 TO 1000 CELLS(行番号,10).VALUE = DATA(行番号,5) CELLS(行番号,11).VALUE = DATA(行番号,6) NEXT (方法2) Dim DATA() As Long ReDim DATA(1 To 1000, 1 To 200) Dim WORK1() As Long ReDim WORK1(1 To 1000, 1 To 1) Dim WORK2() As Long ReDim WORK2(1 To 1000, 1 To 1) FOR 行番号= 1 TO 1000 WORK1(行番号,1) = DATA(行番号,5) WORK2(行番号,1) = DATA(行番号,6) NEXT RANGE("J1:J1000").VALUE = WORK1() RANGE("K1:K1000").VALUE = WORK2() (方法1)より(方法2)の方が早いのですが、WORKに貯めるのもめんどうなので、 RANGE("J1:K1000").VALUE = DATA(1,5), DATA(2,5), DATA(3,5),~,DATA(999,6),DATA(1000,6)のようなことができればと思います。 よろしくお願いします。

  • EXCEL VBA データのある範囲の特定が悪い?  

    アンケート調査票を簡単につくために、下のようなマクロを教えていただいたのですが、もとデータ項目の参照範囲がセルのB5より上にあるもの(空白の場合も)も項目としてしまっているようなので、どこを手直しすればいいのか、すみませんが教えてください。 Sub test() '定数の設定 Const strInputSheet As String = "Sheet1" Const lngInputRow As Long = 5 Const lngInputCol As Long = 2 Const strOutputSheet As String = "Sheet2" Const lngOutputCol As Long = 3 Const lngOutputRow As Long = 4 Const strMessageA As String = " は " Const strMessageB As String = " に対してどの位影響があると思いますか?" '定義 Dim lngMaxRow As Long Dim lngCountA As Long Dim lngCountB As Long Dim strA As String Dim strB As String Dim lngRow As Long '項目数を把握 Sheets(strInputSheet).Select Cells(ActiveSheet.Rows.Count, lngInputCol).Select Selection.End(xlUp).Select lngMaxRow = Selection.Row 'B列のデータ最終行を取得 lngRow = lngOutputRow '出力開始行の設定 '項目Aをなめる For lngCountA = lngInputRow To lngMaxRow  strA = Cells(lngCountA, lngInputCol).Value '項目Aの取得  '項目Bをなめる  For lngCountB = 1 To lngMaxRow   If lngCountA <> lngCountB Then '項目Aと項目Bが同じときはここは処理しない    strB = Cells(lngCountB, lngInputCol).Value '項目Bを取得    Sheets(strOutputSheet).Cells(lngRow, lngOutputCol).Value = strA & strMessageA & strB & strMessageB '文字列を結合    lngRow = lngRow + 1 '改行する   End If  Next lngCountB Next lngCountA End Sub

  • Yes・Noで表示するメッセージで、Yesの場合はコードを実行するので

    Yes・Noで表示するメッセージで、Yesの場合はコードを実行するのですが、 Noの場合にも「完了」が最後に表示されてしまいます。 Noの場合は何もなく終了したいのですが、どのようにしたらいいでしょうか? Sub test() Dim i As Long, r As Long Dim SH As Worksheet Dim ans As Integer Set SH = Sheets("シート") ans = MsgBox("入力年月日、入力担当は正しいですか?", vbYesNo) If ans = vbYes Then 実行コードfor ~Next   End If MsgBox "完了" End Sub

  • エクセルの複数条件抽出

    エクセルで複数条件のカウントをしようと思い、下のマクロを作成しました。 うまくカウントができないのですが、どこらへんが間違っていますでしょうか? (実際にはもっと多くのデータで利用を予定しており、小さいものでテストしています) よろしくお願いします。 Dim c1 As String Dim c2 As String Dim ans As Long Dim ws As Worksheet Dim b As Long, a As Long Set ws = Worksheets("date") For b = 2 To 4 For a = 3 To 5 c1 = Cells(a, 1).Value c2 = Cells(2, b).Value With ws.Range("B2:C7") ans = Evaluate("sumproduct((" & .Columns("c").Address & "=""" & c1 & """)*(" & .Columns("B").Address & "=""" & c2 & """))") Worksheets("a").Cells(a, b).Value = ans End With Next a Next b End Sub

  • Excel2016 VBA

    Windows10 ,Excel2016 バージョン1809 , VBA7.1を使用しています。 下記のコード(ホームページに掲載されているコードを写して実行しようとした。)で、 Attributeの箇所に、 コンパイルエラーと構文エラーが出ます。 Module1をaaaにしたり、Attributesと書き換えたりしてもエラーが消えません。 どなたか正常にコンパイルする書き方を教えてください。 お願いします。 Attribute VB_Name = "Module1" '************************************ 'ラベル発行のサンプル '************************************ Option Explicit ' 各項目の配置定義用ユーザー定義 Private Type typLocation X As Long Y As Long COL As Long End Type Private Const cnsSH1 = "DATA" Private Const cnsSH2 = "LABEL" Private Const cnsSH1 = "設定" Private Const cnsOMIT = "除外" '******************************************************************************* ' ラベル発行 '******************************************************************************* Sub PrintLabels() Dim xlApp As Application Dim WBK As Workbook '本ブック Dim SH1 As Worksheet 'DATA Dim SH2 As Worksheet 'LABEL Dim SH3 As Worksheet '設定 Dim tblLoc(1 To 10) As typLocation '項目配置定義(ユーザー定義を配列化) End Sub

  • タスクトレイからアイコンを削除したい

    VB6.0にて、自作のアプリ「zisaku.exe」から、タスクトレイ常駐型の他アプリケーション「aiueo.exe」を再起動したいと考えています。 しかし、色々調べて試してみたのですが、Shell_NotifyIconに設定する設定値が分からず困っています。教えていただけないでしょうか。 (「aiueo.exe」はウィンドウを持たない) 動作フロー (1)「aiueo.exe」のプロセスを削除する。(タスクマネージャにて確認。動作OK) (2)「aiueo.exe」のタスクトレイアイコンを削除する。(設定値が分からない) (3)「aiueo.exe」を起動する。(起動後は自動でタスクトレイに入る) 開発環境 WindowsXP SP2 VB6.0-SP6 コード 'タスクトレイ関連の構造体と定数 Private Type NOTIFYICONDATA cbSize As Long hWnd As Long uID As Long uFlags As Long uCallbackMessage As Long hIcon As Long szTip As String * 64 dwState As Long dwStateMask As Long End Type Private Const NIF_ICON = &H2 Private Const NIF_MESSAGE = &H1 Private Const NIF_TIP = &H4 Private Const NIM_ADD = &H0 Private Const NIM_DELETE = &H2 Private Const NIM_MODIFY = &H1 Private Const WM_MOUSEMOVE = &H200 Private Const WM_LBUTTONDBLCLK = &H203 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Private Const WM_RBUTTONDBLCLK = &H206 Private Const WM_RBUTTONDOWN = &H204 Private Const WM_RBUTTONUP = &H205 Private Sub aiueoReStart() Dim intCnt As Integer Dim lngRet As Long Dim strBuf As String Dim strSql As String Dim lobjProcess As Object Dim lstrModule As String Dim NID As NOTIFYICONDATA lstrModule = "aiueo.exe" 'プロセスを削除する。 strSql = "SELECT * FROM win32_process WHERE name='" & lstrModule & "'" For Each lobjProcess In GetObject("winmgmts:").ExecQuery(strSql) If lstrModule = lobjProcess.Name Then lobjProcess.Terminate End If Next 'Shell_NotifyIconを使ってタスクトレイより削除する。 'NIDの設定値が分からない。 '色々試して見たけど巧くいかなかった。 Shell_NotifyIcon NIM_DELETE, NID lngRet = Shell("C:\Program Files\aiueo.exe", vbNormalNoFocus) If lngRet = 0 Then lngRet = MsgBox("起動失敗!", vbCritical) End If Exit Sub End Sub 以上です。 どうかよろしくお願い致します。 (質問するカテゴリを間違えていたため、一時削除しました。申し訳ありません。)

  • VBAでフォームにおけるコマンドが実行されません。

    なんどもすいません。二列目に、二桁の整数の足し算を出題することができるたし算の作問プログラムと、続いて三列目に、足し算の解答をして、それの正誤を確かめるプログラムを、それぞれフォームで”問題”、”採点”とした時、一回フォームのウィンドウを閉じてしまうと”採点”のコマンドを押しても、うまく実行されません。 im Ans() As Long Dim n As Variant Private Sub monndai_Click() Dim x As Long, y As Long Columns("B:F").Clear n = InputBox("問題数は?") If Not IsNumeric(n) Then Exit Sub If n <= 0 Then Exit Sub ReDim Ans(n) As Long For i = 1 To n Randomize x = Int(Rnd * 100) Randomize y = Int(Rnd * 100) Ans(i) = x + y Cells(i, 2) = "(" & i & ") " & x & " + " & y & " = " Next i End Sub Private Sub saiten_Click() t = 0 Dim i As Long For i = 1 To n If Cells(i, 3) = Ans(i) Then Cells(i, 4) = "○": t = t + 1 Else Cells(i, 4) = "×": End If Next i tokutenn = "貴方の正答率は" & Int(t / n) & "%です" End Sub (注)tokutennはフォームのテキストボックスのオブジェクト名です。

  • WriteFileの引数について

    APIを学習中の初心者です。 サンプルコードにあったのですが、test0623.txt のテキストを作成し、「abcde」と書き込むというものです。 Const GENERIC_WRITE = &H40000000 Const GENERIC_READ = &H80000000 Const FILE_ATTRIBUTE_NORMAL = &H80 Const CREATE_ALWAYS = 2 Const OPEN_ALWAYS = 4 Const INVALID_HANDLE_VALUE = -1 Private Declare Function CloseHandle Lib "kernel32" ( _ ByVal hObject As Long) As Long Private Declare Function WriteFile Lib "kernel32" ( _ ByVal hFile As Long, lpBuffer As Any, _ ByVal nNumberOfBytesToWrite As Long, _ lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long Private Declare Function CreateFile Lib "kernel32" _ Alias "CreateFileA" (ByVal lpFileName As String, _ ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _ ByVal lpSecurityAttributes As Long, _ ByVal dwCreationDisposition As Long, _ ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long Sub test1() Dim hFile As Long Dim FileName As String Dim Sampledata() As Byte Dim BytesToWritten As Long Dim SC As Long FileName = "test0623.txt" SC = StrConv("abcde", vbFromUnicode) hFile = CreateFile(FileName, GENERIC_WRITE Or GENERIC_READ, _ 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0) SC = WriteFile(hFile, Sampledata(0), _ UBound(Sampledata), BytesToWritten, 0) Call CloseHandle(hFile) End Sub とあったのですが質問は以下の通りです。    (1) SC = WriteFile(hFile, Sampledata(0), UBound(Sampledata), BytesWritten, 0) で、な ぜ、lpBuffer(第1引数)にSampledata(0)を指定すれば、ファイルに書き込むべきデータを保持しているバッファへのポインタになるのか?またSampledata(0)のように配列にする理由が不明? (2) SC = WriteFile(hFile, Sampledata(0), UBound(Sampledata), BytesWritten, 0) で、なぜ、  nNumberOfBytesToWrite(第2引数)に UBound(Sampledata)を指定すれば、ファイルに書き込むべきバイト数になるのか?ここで、0を指定すると、何も書き込まないらしい。 (3) SC = WriteFile(hFile, Sampledata(0), UBound(Sampledata), BytesWritten, 0) で、なぜ、lpNumberOfBytesWritten(第3引数)に何の値も格納していない BytesWritten を記述しているのか?MSDNライブラリには、「関数から制御が返ると、この変数に、実際に書き込まれたバイト数が格納されます。」とあるので、指定しなくてよいのか?    (4) Pathを指定していないが、なぜか、C:\Users\123\Documents に作成される。 以上です。よろしくお願いします