エクセル2010のvbaについて

質問

vbaの勉強であるパズルのゲームを作ろうとしたのですが
ブロックの判定が難しくてどうコードを書けばいいのか分かりません

（一応書けましたがコードがとても長く1,2秒以上掛かってしまいます）

ブロックの判定の仕方は塊で斜めマスは無く
クリックしてからもう一回クリックするとそのブロックが消え
上のブロックが落ちてきます

回答お願いします

回答No.1

nishi6 · ベストアンサー

おもしろそうなので作ってみました。昔あったサメガメ（Same Game風パズル？）

添付図（Sheet1）でいえば、セル範囲B2:H8に「TABLE」の範囲名を付けて、コマンドボタンを1つ配置しています。
コードを見れば分かると思いますが、このボタンで問題図を自動作成しています。

またセル範囲B2:H8には、条件付き書式で、セルの値が1、2、3のとき、1＝黄、2＝赤、3＝青で塗っています。

＞クリックしてからもう一回クリックするとそのブロックが消え
　　この操作がよくわからないので、消したいブロック内のセルでダブルクリックすると消えるようにしてみました。

ボタンで問題図の作成→ダブルクリックで消す　の順で遊びます。

＞ブロックの判定が難しくてどうコードを書けばいいのか分かりません
　　判定というより、ダブルクリックしたセルと同じ値のセルを上下左右と調べ「9」を書き込んでいます。行き止まりがあると、再起の仕組みで枝分かれした個所から再度調べてくれます。逐次上下左右をコーディングするとそれは大変でしょう。何となく機械に任せてる感覚？でしょうか。

’Sheet1のコードウィンドウ

Option Explicit

Dim TBL As Variant　'テーブル
Dim r As Integer　　'行カウンタ
Dim c As Integer　　'列カウンタ
Const rMax = 7　　　'最大行数
Const cMax = 7　　　'最大列数

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　If Target.Count = 1 Then
　　　　If Application.Intersect(Range("TABLE"), Target) Is Nothing Then
　　　　　　Exit Sub
　　　　End If
　　Else
　　　　Exit Sub
　　End If

　　Dim r0 As Integer 'ダブルクリックした行
　　Dim c0 As Integer 'ダブルクリックした列
　　Dim num As Integer 'ダブルクリックしたセルの値
　　　　r0 = Target.Row - 1
　　　　c0 = Target.Column - 1
　　　　num = Target.Value

　　Call paint(num, r0, c0) '// ブロックを「9」にする
　　Call BlockClear　　　　 '// ブロックを消す
End Sub

'// ブロックを「9」にする
Sub paint(n As Integer, rr As Integer, cc As Integer)
　　If TBL(rr, cc) = n Then
　　　　TBL(rr, cc) = 9 '同じ値なら「9」=ブロック
　　Else
　　　　Exit Sub
　　End If

　　'// 再帰
　　If cc < cMax Then Call paint(n, rr, cc + 1) '右
　　If rr < rMax Then Call paint(n, rr + 1, cc) '下
　　If 1 < cc Then Call paint(n, rr, cc - 1)　　'左
　　If 1 < rr Then Call paint(n, rr - 1, cc)　　'上
End Sub

'// ブロックを消す
Sub BlockClear()
　　Dim rg As Range 'セル
　　Dim d As Integer '消去行カウンタ

　　For c = 1 To cMax
　　　　For r = 1 To rMax
　　　　　　If TBL(r, c) = 9 Then
　　　　　　　　For d = r To 2 Step -1
　　　　　　　　　　TBL(d, c) = TBL(d - 1, c)
　　　　　　　　Next
　　　　　　　　TBL(1, c) = ""
　　　　　　End If
　　　　Next
　　Next
End Sub

'// テーブルを作る
Private Sub CommandButton1_Click()
　　Dim rg As Range 'セル

　　Set TBL = Range("TABLE")
　　　　For Each rg In TBL
　　　　　　rg = Int(Rnd() * 3 + 1)
　　　　Next
End Sub

お礼

ありがとうございました
解決しました

まだまだ勉強不足なのでもっと頑張ります

回答No.2

nishi6

読み直してみると、一番大事な個所に誤字がありました。

＞ブロックの判定が難しくてどうコードを書けばいいのか分かりません
　　判定というより、・・。行き止まりがあると、再起の仕組み・・・
　　　　　　　　　　　　　　　　　　　　　↓　　　　　　　
　　判定というより、・・。行き止まりがあると、再帰の仕組み・・・

再起→再帰です。失礼しました。