[[20110515060753]]　『ルーレットについて』（yo）　ページの最後に飛ぶ

『ルーレットについて』（yo）

 あるサイトから「重複しない数字を出すルーレット」のコードをDLしました。
 下のコードでは、０～２４までの数字が出ます。
 それを１～２５までの数字が出るようにしたいのです。
 VBA初心者の自分が、いろいろいじってもだめでした。
 どなたか教えていただけないでしょうか?

 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

 Sub ROULETTE()
 Dim slpTime As Integer
 Dim myRandSpan As Integer 
 Dim rt As Integer 
 Dim i As Integer
 Dim myNum As Integer

 myRandSpan = 25
 rt = 1
 slpTime = 1
 Do
 Randomize
 n = Int(Rnd() * myRandSpan)
 mycol = Range(Cells(ActiveSheet.Rows.Count, 3) _
        .End(xlUp).Address).Row + 1
 If mycol - 6 >= myRandSpan Then
    MsgBox "これ以上は抽選できません" & Chr(13) _
         & "（履歴を削除してください）"
    Exit Sub
 End If

  Range("C4").Formula = "=COUNTIF(C6:C" & mycol - 1 _
                    & "," & n & ")"
 Loop Until Range("C4").Value = 0

 myNum = n
 For i = 1 To rt * myRandSpan + 1
   Sleep i * slpTime
   Sheets(2).Range("C2").Value = myNum
   myNum = myNum + 1
   myNum = myNum Mod myRandSpan
   DoEvents
 Next i
 Sleep 300

 Sheets(2).Cells(mycol, 3).Value = Sheets(2) _
 .Range("C2").Value
 End Sub

 いろいろと矛盾のあるコードなのですが、表示対象は現在のシートなのでしょうか？
 2番目のシートなのでしょうか？
 混在しているので、現在のシートを対象にするように変更しました。

 乱数は0～で発生しますので基本的には１を足せばよいのですが、表示箇所で調整が
 必要ですね。冗長な部分も多いので、あわせて変更してみました。
 （C4 は作業用セルなので、使わないようにしています。）

 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 Sub Roulette改()
    Const myRandSpan = 25    '--- 数値の範囲
    Const rt = 1             '--- ルーレットの回転数
    Const slpTime = 5        '--- ルーレットの回転速度

    Const StartAddress = "C6"     '--- 結果の表示開始位置
    Const RouletteAddress = "C2"  '--- ルーレットの表示位置

    If Application.WorksheetFunction.CountA(Range(StartAddress).Resize(myRandSpan, 1)) = myRandSpan Then
       MsgBox "これ以上は抽選できません" & Chr(13) & "（履歴を削除してください）"
       Exit Sub
    End If

    Dim lastCell As Range
    Set lastCell = Cells(Rows.Count, Range(StartAddress).Column).End(xlUp).Offset(1, 0)
    If lastCell.Row < Range(StartAddress).Row Then Set lastCell = Range(StartAddress)

    Randomize
    Dim i As Long
    Dim nextNum As Long
    nextNum = Int(Rnd() * myRandSpan) + 1   '★ここ
    For i = 1 To myRandSpan
        If Application.WorksheetFunction.CountIf(Range(StartAddress).Resize(myRandSpan, 1), nextNum) = 0 Then Exit For
        nextNum = nextNum Mod myRandSpan + 1    '★ここ
    Next

    For i = 0 To rt * myRandSpan - 1
        Range(RouletteAddress).Value = (nextNum + i) Mod myRandSpan + 1   '★ここ
        Sleep i * slpTime
        DoEvents
    Next i
    Range(RouletteAddress).Value = nextNum
    lastCell.Value = nextNum
 End Sub
 (Mook)

 Mook様、素早いご返事ありがとうございました。

 >乱数は0～で発生しますので基本的には１を足せばよいのですが、

 「+1」をいろいろな所に入れてやってみて…途方に暮れていたところでした。
 ご提示いただいたコードでばっちりでした。

 本当にありがとうございました。(yo)

 ちょっとバグ修正
 (Mook)

コメント返信：

[ 一覧(最新更新順) ]

[[20110515060753]] 『ルーレットについて』（yo） ページの最後に飛ぶ

[[20110515060753]]　『ルーレットについて』（yo）　ページの最後に飛ぶ