Results of 1 - 1 of about 37670 for IF (0.008 sec.)
- [[20101023215523]]
- #score: 1591
- @digest: 0541686adadf36db325dae01e53d05e5
- @id: 51836
- @mdate: 2010-10-25T10:18:33Z
- @size: 17517
- @type: text/plain
- #keywords: checkarray (73808), bingo (45938), 部ピ (38796), makerandomnumbers (29993), checkbingo (29523), topleft (27727), card (22848), randnums (22494), 乱数 (22307), crng (17733), interior (17409), ビン (14583), colorindex (14323), maxnum (14291), myrnd (13938), 数( (10896), 目") (8901), vbcrlf (8899), xlcenter (7764), し色 (7577), formatconditions (6843), vbcancel (5847), vbokcancel (5143), ピン (5005), の塗 (4918), xlexpression (4604), g0 (4444), ンゴ (4411), msgbox (4080), randomize (3925), ・" (3492), collection (3274)
- 『ビンゴの判定について（VBA)』（はこまる）
Private Sub CommandButton2_Click() Dim i As Integer Dim j As Integer Dim k As Integer Dim 数字() As Long Dim 乱数(75) As Long Dim 比較用(75) As Integer Dim z As String Dim b As Variant '乱数を発生させる Randomize For i = 1 To 75 Do 乱数(i) = Int(Rnd() * 75 + 1) If Not 比較用(乱数(i)) = 1 Then 比較用(乱数(i)) = 1 Exit Do Else End If Loop Next '○回目のところの数字 For j = 1 To 75 Cells(2, 8) = j Range("h3:j5") = 乱数(j) '記録表 If j <= 15 Then Cells(10, j + 1) = 乱数(j) ElseIf j <= 30 Then Cells(12, j - 14) = 乱数(j) ElseIf j <= 45 Then Cells(14, j - 29) = 乱数(j) ElseIf j <= 60 Then Cells(16, j - 44) = 乱数(j) ElseIf j <= 75 Then Cells(18, j - 59) = 乱数(j) End If '同じ番号に色を付ける z = Cells(6, 8) If z <> "" Then With Range(z).Interior .ColorIndex = 7 End With End If z = Cells(6, 9) If z <> "" Then With Range(z).Interior .ColorIndex = 7 End With End If '次の番号を出すか終わらせるかを問う質問 If MsgBox(乱数(j) & "番です。" & vbCrLf & _ "終了する時はキャンセルを押してください。" _ , vbOKCancel, j & "回目") = vbCancel Then End: '列がそろったときに表示するメッセージ b = "ビンゴです!おめでとうございます!" If Range("b3,c3,d3,e3,f3") = Interior.ColorIndex = 7 Then Exit For MsgBox (b) Else If Range("b4,c4,d4,e4,f4") = Interior.ColorIndex = 7 Then Exit For MsgBox (b) Else If Range("b5,c5,d5,e5,f5") = Interior.ColorIndex = 7 Then Exit For MsgBox (b) Else If Range("b6,c6,d6,e6,f6") = Interior.ColorIndex = 7 Then Exit For MsgBox (b) Else If Range("b7,c7,d7,e7,f7") = Interior.ColorIndex = 7 Then Exit For MsgBox (b) Else If Range("b3,b4,b5,b6,b7") = Interior.ColorIndex = 7 Then Exit For MsgBox (b) Else If Range("c3,c4,c5,c6c7") = Interior.ColorIndex = 7 Then Exit For MsgBox (b) Else If Range("d3,d4,d5,d6,d7") = Interior.ColorIndex = 7 Then Exit For MsgBox (b) Else If Range("e3,e4,e5,e6,e7") = Interior.ColorIndex = 7 Then Exit For MsgBox (b) Else If Range("f3,f4,f5,f6,f7") = Interior.ColorIndex = 7 Then Exit For MsgBox (b) Else If Range("b3,c4,d5,e6,f7") = Interior.ColorIndex = 7 Then Exit For MsgBox (b) Else If Range("f3,e4,d5,c6,b7") = Interior.ColorIndex = 7 Then Exit For MsgBox (b) End If End If End If End If End If End If End If End If End If End If End If End If Next End Sub とまぁ自分なりに考えてに書いてみたのですが、 実行すると「オブジェクトが必要です」と怒られてしまいます。 そして「 If Range("b3,c3,d3,e3,f3") = Interior.ColorIndex = 7 Then」のところに 黄色いマーカーが入ります。 私やりたいことが分かるでしょうか。 縦横斜め一列同じ色がそろったらforを中止してメッセージボックスを表示したいのです。 どこがいけないのか、分かる方ご指導ください。 windowsXP Excel2003 ---- コード内容はほとんど見ていませんが If Range("b3,c3,d3,e3,f3") = Interior.ColorIndex = 7 Then ↓ If Range("b3,c3,d3,e3,f3") . Interior.ColorIndex = 7 Then に変えて下さい。 (通行人) ---- 通行人様、誠にありがとうございます!! できました!できました! 思い通りに動きました! 感謝しきれません。 本当にありがとうございます!!!!! （質問主） ---- すでに解決したようですが、せっかく作ったのでアップします。 推測ですが配置を合わせて、いますので下記のようにすれば、同じボタンから 利用できると思います。 Private Sub CommandButton2_Click() OpenNumber End Sub ところで、（比較の時に Range("b3,c3,d3,e3,f3") のような使い方って 動いています? '---------------------------------------------------- Option Explicit Const MAX_NUMBER = 75 Const CARD_TOPLEFT = "B3" Const INIT_COLOR = 35 Const MATCH_COLOR = 7 '---------------------------------------------------- Sub Bingo() MakeCard OpenNumber End Sub '---------------------------------------------------- Private Sub MakeCard() Dim ws As Worksheet If Worksheets(1).Name <> "BINGO CARD" Then Worksheets.Add before:=Worksheets(1) Worksheets(1).Name = "BINGO CARD" End If Set ws = Worksheets(1) ws.Cells.Interior.ColorIndex = 2 With ws.Range(CARD_TOPLEFT).Resize(5, 5) .EntireRow.RowHeight = 50 .EntireColumn.ColumnWidth = 6 .Borders.LineStyle = xlContinuous .VerticalAlignment = xlCenter .HorizontalAlignment = xlCenter .Characters.Font.Size = 24 .Characters.Font.Bold = True .Interior.ColorIndex = INIT_COLOR End With With Range("H3:J5") .Merge .Borders.LineStyle = xlContinuous .VerticalAlignment = xlCenter .HorizontalAlignment = xlCenter .Characters.Font.Size = 60 .Characters.Font.Bold = True End With Dim i As Long For i = 0 To 4 With Range("B10").Offset(i * 2, 0).Resize(1, 15) .Clear .EntireColumn.ColumnWidth = 6 .VerticalAlignment = xlCenter .HorizontalAlignment = xlCenter .Borders.LineStyle = xlContinuous End With Next ws.Activate Dim randNums randNums = MakeRandomNumbers(MAX_NUMBER) Dim j As Long For i = 0 To 4 For j = 0 To 4 Range(CARD_TOPLEFT).Offset(i, j).Value = randNums(i * 5 + j + 1) Next Next End Sub '---------------------------------------------------- Private Sub OpenNumber() '乱数を発生させる Dim 乱数 乱数 = MakeRandomNumbers(MAX_NUMBER) '○回目のところの数字 Dim j For j = 1 To 75 Cells(2, 8) = j Range("h3:j5") = 乱数(j) '記録表 Cells(10 + Int((j - 1) / 15) * 2, ((j - 1) Mod 15) + 2) = 乱数(j) '同じ番号に色を付ける Dim f As Range Set f = Range(CARD_TOPLEFT).Resize(5, 5).Find(乱数(j), lookat:=xlWhole) If Not f Is Nothing Then f.Interior.ColorIndex = MATCH_COLOR Cells(10 + Int((j - 1) / 15) * 2, ((j - 1) Mod 15) + 2).Interior.ColorIndex = MATCH_COLOR End If If CheckBingo(Range(CARD_TOPLEFT).Resize(5, 5)) = True Then MsgBox "ビンゴです!おめでとうございます!" Exit Sub End If '次の番号を出すか終わらせるかを問う質問 If MsgBox("次は " & j & "番目です。続けますか?" & vbCrLf & _ "終了する時はキャンセルを押してください。" _ , vbOKCancel, j & "回目") = vbCancel Then Exit Sub Next End Sub '---------------------------------------------------- Function MakeRandomNumbers(maxNum) Dim ar() As Long ReDim ar(maxNum) Dim i As Long For i = 1 To maxNum ar(i) = i Next Dim j As Long Dim k As Long Dim t As Long For i = 1 To 30 For j = 1 To maxNum k = (Int(Rnd() * 1000) Mod maxNum) + 1 t = ar(k) ar(k) = ar(j) ar(j) = t Next Next MakeRandomNumbers = ar End Function '---------------------------------------------------- Function CheckBingo(card As Range) As Boolean Dim checkArray(12) As Long Dim i As Long Dim j As Long For i = 1 To 5 For j = 1 To 5 If card.Cells(i, j).Interior.ColorIndex = MATCH_COLOR Then checkArray(j) = checkArray(j) + 1 End If If card.Cells(j, i).Interior.ColorIndex = MATCH_COLOR Then checkArray(j + 5) = checkArray(j + 5) + 1 End If Next If card.Cells(i, i).Interior.ColorIndex = MATCH_COLOR Then checkArray(11) = checkArray(11) + 1 End If If card.Cells(i, 6 - i).Interior.ColorIndex = MATCH_COLOR Then checkArray(12) = checkArray(12) + 1 End If Next CheckBingo = False For i = 1 To 12 If checkArray(i) = 5 Then CheckBingo = True Exit Function End If Next End Function '---------------------------------------------------- (Mook) ---- こんな方法も試してください。 標準モジュールに '==================================================================== Option Explicit Sub ビンゴゲーム() Dim 乱数 As Variant Dim g0 As Long Dim b As Variant Dim crng As Range With Cells .Interior.ColorIndex = xlNone .Clear End With 乱数 = mk_rnd(75) g0 = 1 For Each crng In Range("b3:f7") crng.Value = 乱数(g0) g0 = g0 + 1 Next MsgBox "ビンゴゲーム開始" 乱数 = mk_rnd(75) For g0 = 1 To 75 Cells(2, 8).Value = g0 Range("h3").Value = 乱数(g0) Cells(((g0 - 1) ¥ 15) * 2 + 10, (g0 - 1) Mod 15 + 2).Value = 乱数(g0) '同じ番号に色を付ける Call match_chk(Range("b3:f7"), Range("h3").Value, 7) '列がそろったときに表示するメッセージ b = "ビンゴです!おめでとうございます!" If Not Bingo(Range("b3:f7"), 7) Is Nothing Then MsgBox b Exit For End If '次の番号を出すか終わらせるかを問う質問 If MsgBox(乱数(g0) & "番です。" & vbCrLf & _ "終了する時はキャンセルを押してください。" _ , vbOKCancel, g0 & "回目") = vbCancel Then End: Next End Sub '==================================================================== Function Bingo(ByVal rng As Range, ByVal col As Long) As Range '指定されたセル範囲の縦・横・斜めのラインが指定色のセル範囲を返す Dim crng As Range Dim g0 As Long Set Bingo = Nothing For Each crng In rng.Rows If crng.Interior.ColorIndex = col Then Set Bingo = crng Exit For End If Next If Bingo Is Nothing Then For Each crng In rng.Columns If crng.Interior.ColorIndex = col Then Set Bingo = crng Exit For End If Next End If If Bingo Is Nothing Then If rng.Rows.Count = rng.Columns.Count Then Set crng = rng.Cells(1, 1) For g0 = 1 To rng.Rows.Count - 1 Set crng = Union(crng, crng.Cells(1, 1).Offset(g0, g0)) Next If crng.Interior.ColorIndex = col Then Set Bingo = crng End If End If End If If Bingo Is Nothing Then If rng.Rows.Count = rng.Columns.Count Then Set crng = rng.Cells(1, rng.Columns.Count) For g0 = 1 To rng.Rows.Count - 1 Set crng = Union(crng, crng.Cells(1, 1).Offset(g0, -g0)) Next If crng.Interior.ColorIndex = col Then Set Bingo = crng End If End If End If End Function '==================================================================== Sub match_chk(ByVal rng As Range, myval As Variant, col As Long) '指定されたセル範囲が指定値のセルを指定色に塗りつぶす Dim rst As Variant Dim ans As Variant Dim g0 As Long rst = Evaluate("=" & rng.Address(, , , True) & "=" & myval) For g0 = LBound(rst, 1) To UBound(rst, 1) With Application ans = .Match(True, .Index(rst, g0, 0), 0) End With If Not IsError(ans) Then rng.Cells(g0, ans).Interior.ColorIndex = col Exit For End If Next End Sub '==================================================================== Function mk_rnd(lim As Long) As Variant '1〜指定値までの数字をランダムに並べた配列を返す Dim g0 As Long Dim g1 As Long Dim col As Collection Set col = New Collection For g0 = 1 To lim col.Add g0 Next ReDim wk(1 To lim) Randomize g0 = 1 Do While col.Count > 0 g1 = Int(Rnd * col.Count) + 1 wk(g0) = col(g1) col.Remove g1 g0 = g0 + 1 Loop mk_rnd = wk() Set col = Nothing Erase wk() End Function ビンゴゲームを実行してみてください。 ichinose ---- >ところで、（比較の時に Range("b3,c3,d3,e3,f3") のような使い方って >動いています? これについては、 If Range("b3,c3,d3,e3,f3").Interior.ColorIndex = 7 Then このステートメントでいけそうですよ!! 但し、Range("b3,c3,d3,e3,f3").Interior.ColorIndex この結果がNullを返す ことがある ということは認識していないと面倒なことが起きる可能性もありそうです。 例 新規ブックにて試してください。 標準モジュールに '================================================================= Sub sample() With Range("b3,c3,d3,e3,f3") .Interior.ColorIndex = xlNone .Range("a1:e1").Interior.ColorIndex = 7 MsgBox "この状態で" & vbCrLf & _ "If Range(""b3,c3,d3,e3,f3"").Interior.ColorIndex = 7 Then" & vbCrLf & _ " MsgBox Range(""b3,c3,d3,e3,f3"").Address & "" の塗りつぶし色は全部 ピンク""" & vbCrLf & _ "Else" & vbCrLf & _ " MsgBox Range(""b3,c3,d3,e3,f3"").Address & "" の塗りつぶし色は全部がピンクではない""" & vbCrLf & _ "End If" & vbCrLf & _ "上記のコードを実行すると・・・・・" If .Interior.ColorIndex = 7 Then MsgBox .Address & " の塗りつぶし色は全部 ピンク" Else MsgBox .Address & " の塗りつぶし色は全部がピンクではない" End If MsgBox "と この状態だと正常に作動します。又、" .Interior.ColorIndex = xlNone .Range("a1:b1").Interior.ColorIndex = 7 MsgBox "この状態で" & vbCrLf & _ "If Range(""b3,c3,d3,e3,f3"").Interior.ColorIndex = 7 Then" & vbCrLf & _ " MsgBox Range(""b3,c3,d3,e3,f3"").Address & "" の塗りつぶし色は全部 ピンク""" & vbCrLf & _ "Else" & vbCrLf & _ " MsgBox Range(""b3,c3,d3,e3,f3"").Address & "" の塗りつぶし色は全部がピンクではない""" & vbCrLf & _ "End If" & vbCrLf & _ "上記のコードを実行すると・・・・・" If .Interior.ColorIndex = 7 Then MsgBox .Address & " の塗りつぶし色は全部 ピンク" Else MsgBox .Address & " の塗りつぶし色は全部がピンクではない" End If MsgBox "これも正常に作動していますが・・・・。前回のIF文をこのようにすると・・・。" MsgBox "If Range(""b3,c3,d3,e3,f3"").Interior.ColorIndex <> 7 Then" & vbCrLf & _ " MsgBox Range(""b3,c3,d3,e3,f3"").Address & "" の塗りつぶし色は全部がピンクではない""" & vbCrLf & _ "Else" & vbCrLf & _ " MsgBox Range(""b3,c3,d3,e3,f3"").Address & "" の塗りつぶし色は全部 ピンク""" & vbCrLf & _ "End If" & vbCrLf & _ "上記のコードを実行すると・・・・・" If .Interior.ColorIndex <> 7 Then MsgBox .Address & " の塗りつぶし色は全部 ピンクではない" Else MsgBox .Address & " の塗りつぶし色は全部がピンク" End If MsgBox "If条件を逆にしても、結果は、Falseの処理を行っています。" & vbCrLf & _ "ここでNullであることを忘れていると思わぬ 落とし穴がありますから 注意してください" End With End Sub ichinose@Excel2002で確認 ---- ichinose さん、検証ありがとうございました。 文法のはざまを突くような使い方で、できるからと言って使いたいやり方では ありませんが、動くんですねぇ。 勉強になりました。 (Mook) ---- 単純に作ってみましたが・・・ダメですかね? 色じゃなくてワークシート関数で。 Private Sub CommandButton2_Click() Dim myC As New Collection Dim i As Long Dim myRnd As Long With Range("B3:F7") .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF($B$10:$P$18,B3)>0" .FormatConditions(1).Interior.ColorIndex = 7 End With Range("AA3:AE7").Formula = "=COUNTIF($B$10:$P$18,B3)" Range("AF3:AF7").Formula = "=SUM(AA3:AE3)" Range("AA8:AE8").Formula = "=SUM(AA3:AA7)" Range("AA9").Formula = "=SUM(AA3,AB4,AC5,AD6,AE7)" Range("AB9").Formula = "=SUM(AA7,AB6,AC5,AD4,AE3)" For i = 1 To 75 myC.Add i Next i Randomize For i = 1 To 75 Range("H2").Value = i myRnd = Int(Rnd() * myC.Count + 1) Range("H3").Value = myC.Item(myRnd) Range("B10:P10,B12:P12,B14:P14,B16:P16,B18:P18").Cells(i).Value = myC.Item(myRnd) If MsgBox(myC.Item(myRnd) & "番です。" & vbCrLf & _ "終了する時はキャンセルを押してください。", vbOKCancel, i & "回目") = vbCancel Then Exit Sub End If If Application.WorksheetFunction.Max(Range("AA3").CurrentRegion) = 5 Then MsgBox "ビンゴです!おめでとうございます!" End If myC.Remove (myRnd) Next i End Sub （momo） ---- >色じゃなくてワークシート関数で。 へえ、面白い方法ですねえ!! 一つだけ・・・、 With Range("B3:F7") .Select .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression,Formula1:="=COUNTIF($B$10:$P$18,B3)>0" .FormatConditions(1).Interior.ColorIndex = 7 End With としておかないと=COUNTIF($B$10:$P$18,B3)>0 この数式が正しい相対アドレスになりませんね!! ichinose ---- ichinoseさんに面白がってもらえて光栄です。 おっと・・・相対アドレスでしたね・・・IV65536とかなっちゃいますね。 最初から .FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF(R10C2:R18C16,RC)>0" とでもしておけば良かったですね〜 ご指摘ありがとうございます(^^) （momo）... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201010/20101023215523.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97018 documents and 608145 words.
訪問者：