エクセルで作ったテトリスを少し改良しました。ずっと良くなりましたよ！
記事IT・テクノロジー
先日の日曜日、エクセルでテトリスを作りました。半日でできました。ブログで、コードをさらしたのですが、その翌日に、私はいくつか書き直して、もう少しマシなものにしました。
前回からの変更点を書きますね。
まず、少し不具合があったのです。右に行くとき、すり抜けてしまうという不具合がありました。これは、原因を見つけて直しました。数字を１箇所、間違えていました。もう不具合はないだろうと思っています。
また、前回のは、「クリア」がありませんでした。終了するのは「ゲームオーバー」しかなかったのです。ひどい話ですよね（笑）。ちょっと考えまして、「１０回消したらクリア」としました。
それから、速さの段階が極端でした。もう少し速さの段階をマメにしまして、「ゆっくり」「ややゆっくり」「普通」「やや速い」「速い」「すごく速い」の６段階にいたしました。私自身はあまりテトリスが強くないので、レベル３（「普通」）くらいでちょうどよいです。
あと、色を変えました。いままでのは、濃い中間色がほとんどだったと思います。今度は、原色を中心として、カラフルにしました。パソコンは３色（赤、緑、青）が基本で、さらに白や黒、シアンやマゼンタといった色（すみません。よくわかりません。私自身は色弱で、色がよくわからないのです。数字で操作しているだけです）がありますが、そのちょうど８色で書いています。ずっと見やすくなったと言われます。昔ながらのファミコンみたいな感じの色になったみたいです。レトロな感じですかね。
セルの大きさも少し変えました。大きめのバージョンも作ったのです。でも、もしこのゲームで遊んでくださるかたがいらっしゃったとして、そのかたのマシンで画面に入りきらなかったらいけないと思い（下が入りきらなかったらプレイできないですよね）、いままでと同じ大きさ（小さめ）のコードをさらしますね。
画面が左寄りなのはすみません。タテが３０、ヨコが１５というのもいくらでも変えられるのですが、最初に３０×１５で作ってみて、ちょうどいい気がしましたので、そのままです。
「１０回消したらクリア」の「１０回」というのもいくらでも変えられるのですが、プレイしてみて、１０回消したらクリアというのがちょうどよいと感じますので、これもこのままです。
ウィンドウズの６４ビット版でしか動きません。それから、標準モジュールというところにコピペしないと動かないと思います。エクセルファイルを新規で作っていただきまして、マクロの「標準モジュール」というのを挿入していただき、そこに貼り付けてください。
以下に最新版のコードをさらしますね。
Option Explicit
Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
Sub テトリス()
Dim shurui As Integer
Dim ochigyou(1 To 4), ochiretu(1 To 4) As Integer
Dim hayasa, hayaokuri, hayasas As Integer
Dim tate, yoko As Integer
Dim px As Double
tate = 30
yoko = 15
Dim sude(1 To 100, 1 To 100, 1 To 3) As Integer
Dim i, j, k, n, x, p, q As Integer
Dim a(1 To 4), b(1 To 4) As Integer
Dim iro(1 To 7, 1 To 3) As Integer
Dim PressNumber(1 To 5) As Integer
Dim narabi, kaisuu As Integer
Dim tuyosa As Integer
Dim tuyosastr As String
Dim keshi, keshikazu As Integer
'初期化
'何回消したらクリアか
keshikazu = 10
'色を定める
iro(1, 1) = 255
iro(1, 2) = 0
iro(1, 3) = 0
iro(2, 1) = 0
iro(2, 2) = 255
iro(2, 3) = 0
iro(3, 1) = 0
iro(3, 2) = 0
iro(3, 3) = 255
iro(4, 1) = 255
iro(4, 2) = 255
iro(4, 3) = 0
iro(5, 1) = 255
iro(5, 2) = 0
iro(5, 3) = 255
iro(6, 1) = 0
iro(6, 2) = 255
iro(6, 3) = 255
iro(7, 1) = 0
iro(7, 2) = 0
iro(7, 3) = 0
'メッセージ
MsgBox "「←」「→」のキーで左右に動きます。「z」「x」のキーで左右に回転します。「↓」で早送りできます。" & keshikazu & "回以上消したらクリアです。"
tuyosastr = InputBox("速さを選んでください。1.ゆっくり。2.ややゆっくり。3.普通｡ 4.やや速い。5.速い｡ 6.すごく速い｡ ")
tuyosa = Int(Val(tuyosastr))
Select Case tuyosa
Case 1
hayasas = 60
Case 2
hayasas = 30
Case 3
hayasas = 20
Case 4
hayasas = 14
Case 5
hayasas = 10
Case 6
hayasas = 5
Case Else
hayasas = 20
End Select
'速さを定める
hayaokuri = 3
'セルを正方形にする
px = 12 '正方形の一辺の長さ[px]
' セルの高さと幅を設定
Cells.ColumnWidth = px * 0.118
Cells.RowHeight = px * 0.75
Cells.Clear
Range(Cells(1, yoko + 1), Cells(2, yoko + 2)).MergeCells = True
Cells(1, yoko + 1).Font.Size = 12
Cells(1, yoko + 1).HorizontalAlignment = xlCenter
Cells(1, yoko + 1).VerticalAlignment = xlCenter
Cells(1, yoko + 1).Value = 0
'本当のゲームスタート
'すべて白
For i = 1 To tate
For j = 1 To yoko
For k = 1 To 3
sude(i, j, k) = 255
Range(Cells(i, j), Cells(i, j)).Interior.Color = RGB(255, 255, 255)
Next
Next
Next
keshi = 0
'ゲームスタート
'上に発生する
L1:
x = 0
hayasa = hayasas
shurui = Int(Rnd * 7) + 1
Select Case shurui
Case 1
ochigyou(1) = 3
ochiretu(1) = Int(yoko / 2)
ochigyou(2) = 1
ochigyou(3) = 2
ochigyou(4) = 4
For j = 1 To 3
ochiretu(j + 1) = ochiretu(1)
Next
Case 2
ochigyou(1) = 1
ochiretu(1) = Int(yoko / 2)
ochigyou(2) = 2
ochiretu(2) = ochiretu(1)
ochigyou(3) = 1
ochiretu(3) = ochiretu(1) + 1
ochigyou(4) = 2
ochiretu(4) = ochiretu(1) + 1
Case 3
ochigyou(1) = 2
ochiretu(1) = Int(yoko / 2)
ochigyou(2) = 1
ochiretu(2) = ochiretu(1)
ochigyou(3) = 2
ochiretu(3) = ochiretu(1) - 1
ochigyou(4) = 2
ochiretu(4) = ochiretu(1) + 1
Case 4
ochigyou(1) = 1
ochiretu(1) = Int(yoko / 2)
ochigyou(2) = 2
ochiretu(2) = ochiretu(1)
ochigyou(3) = 1
ochiretu(3) = ochiretu(1) - 1
ochigyou(4) = 1
ochiretu(4) = ochiretu(1) - 2
Case 5
ochigyou(1) = 1
ochiretu(1) = Int(yoko / 2)
ochigyou(2) = 2
ochiretu(2) = ochiretu(1)
ochigyou(3) = 1
ochiretu(3) = ochiretu(1) + 1
ochigyou(4) = 1
ochiretu(4) = ochiretu(1) + 2
Case 6
ochigyou(1) = 2
ochiretu(1) = Int(yoko / 2)
ochigyou(2) = 1
ochiretu(2) = ochiretu(1)
ochigyou(3) = 2
ochiretu(3) = ochiretu(1) - 1
ochigyou(4) = 1
ochiretu(4) = ochiretu(1) + 1
Case 7
ochigyou(1) = 2
ochiretu(1) = Int(yoko / 2)
ochigyou(2) = 1
ochiretu(2) = ochiretu(1)
ochigyou(3) = 2
ochiretu(3) = ochiretu(1) + 1
ochigyou(4) = 1
ochiretu(4) = ochiretu(1) - 1
End Select
For i = 1 To 4
Range(Cells(ochigyou(i), ochiretu(i)), Cells(ochigyou(i), ochiretu(i))).Interior.Color = RGB(iro(shurui, 1), iro(shurui, 2), iro(shurui, 3))
Next
For k = 1 To 4
If sude(ochigyou(k), ochiretu(k), 1) < 255 Or sude(ochigyou(k), ochiretu(k), 2) < 255 Or sude(ochigyou(k), ochiretu(k), 3) < 255 Then
GoTo L3
End If
Next
'待つ
L4:
For i = 1 To hayasa
Application.Wait [Now()] + 0.01 / 86400
If PressLeft = True Then
PressNumber(1) = 1
End If
If PressRight = True Then
PressNumber(2) = 1
End If
If PressZ = True Then
PressNumber(3) = 1
End If
If PressX = True Then
PressNumber(4) = 1
End If
If PressDown = True Then
PressNumber(5) = 1
End If
If PressNumber(1) = 1 Then
For j = 1 To 4
If ochiretu(j) = 1 Then
PressNumber(1) = 0
ElseIf sude(ochigyou(j), ochiretu(j) - 1, 1) < 255 Or sude(ochigyou(j), ochiretu(j) - 1, 2) < 255 Or sude(ochigyou(j), ochiretu(j) - 1, 3) < 255 Then
PressNumber(1) = 0
End If
Next
If PressNumber(1) = 1 Then
For k = 1 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(255, 255, 255)
Next
For k = 1 To 4
ochiretu(k) = ochiretu(k) - 1
Next
For k = 1 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(iro(shurui, 1), iro(shurui, 2), iro(shurui, 3))
Next
PressNumber(1) = 0
End If
End If
If PressNumber(2) = 1 Then
For j = 1 To 4
If ochiretu(j) = yoko Then
PressNumber(2) = 0
ElseIf sude(ochigyou(j), ochiretu(j) + 1, 1) < 255 Or sude(ochigyou(j), ochiretu(j) + 1, 2) < 255 Or sude(ochigyou(j), ochiretu(j) + 1, 3) < 255 Then
PressNumber(2) = 0
End If
Next
If PressNumber(2) = 1 Then
For k = 1 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(255, 255, 255)
Next
For k = 1 To 4
ochiretu(k) = ochiretu(k) + 1
Next
For k = 1 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(iro(shurui, 1), iro(shurui, 2), iro(shurui, 3))
Next
PressNumber(2) = 0
End If
End If
If PressNumber(3) = 1 Then
Select Case shurui
Case 1, 3, 4, 5, 6, 7
For k = 2 To 4
a(k) = ochigyou(1) + (ochiretu(1) - ochiretu(k))
b(k) = ochiretu(1) - (ochigyou(1) - ochigyou(k))
If a(k) > tate Or a(k) < 1 Or b(k) > yoko Or b(k) < 1 Then
PressNumber(3) = 0
If PressNumber(3) = 1 Then
If sude(a(k), b(k), 1) < 255 Or sude(a(k), b(k), 2) < 255 Or sude(a(k), b(k), 3) < 255 Then
PressNumber(3) = 0
End If
End If
End If
Next
If PressNumber(3) = 1 Then
For k = 2 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(255, 255, 255)
Next
For k = 2 To 4
ochigyou(k) = a(k)
ochiretu(k) = b(k)
Next
For k = 2 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(iro(shurui, 1), iro(shurui, 2), iro(shurui, 3))
Next
PressNumber(3) = 0
End If
Case 2
PressNumber(3) = 0
End Select
End If
If PressNumber(4) = 1 Then
Select Case shurui
Case 1, 3, 4, 5, 6, 7
For k = 2 To 4
a(k) = ochigyou(1) - (ochiretu(1) - ochiretu(k))
b(k) = ochiretu(1) + (ochigyou(1) - ochigyou(k))
If a(k) > tate Or a(k) < 1 Or b(k) > yoko Or b(k) < 1 Then
PressNumber(4) = 0
If PressNumber(4) = 1 Then
If sude(a(k), b(k), 1) < 255 Or sude(a(k), b(k), 2) < 255 Or sude(a(k), b(k), 3) < 255 Then
PressNumber(4) = 0
End If
End If
End If
Next
If PressNumber(4) = 1 Then
For k = 2 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(255, 255, 255)
Next
For k = 2 To 4
ochigyou(k) = a(k)
ochiretu(k) = b(k)
Next
For k = 2 To 4
Range(Cells(ochigyou(k), ochiretu(k)), Cells(ochigyou(k), ochiretu(k))).Interior.Color = RGB(iro(shurui, 1), iro(shurui, 2), iro(shurui, 3))
Next
PressNumber(4) = 0
End If
Case 2
PressNumber(4) = 0
End Select
End If
If PressNumber(5) = 1 Then
hayasa = hayaokuri
PressNumber(5) = 0
Exit For
End If
Next
'落ちる
x = 0
For k = 1 To 4
If sude(ochigyou(k) + 1, ochiretu(k), 1) < 255 Or sude(ochigyou(k) + 1, ochiretu(k), 2) < 255 Or sude(ochigyou(k) + 1, ochiretu(k), 3) < 255 Or ochigyou(k) >= tate Then
x = 1
End If
Next
If x = 0 Then
For j = 1 To 4
Range(Cells(ochigyou(j), ochiretu(j)), Cells(ochigyou(j), ochiretu(j))).Interior.Color = RGB(255, 255, 255)
Next
For j = 1 To 4
ochigyou(j) = ochigyou(j) + 1
Next
For j = 1 To 4
Range(Cells(ochigyou(j), ochiretu(j)), Cells(ochigyou(j), ochiretu(j))).Interior.Color = RGB(iro(shurui, 1), iro(shurui, 2), iro(shurui, 3))
Next
GoTo L4
Else
For k = 1 To 4
For i = 1 To 3
sude(ochigyou(k), ochiretu(k), i) = iro(shurui, i)
Next
Next
For kaisuu = 1 To 4
For i = 1 To tate
narabi = 0
For j = 1 To yoko
If sude(i, j, 1) < 255 Or sude(i, j, 2) < 255 Or sude(i, j, 3) < 255 Then
narabi = narabi + 1
End If
Next
If narabi = yoko Then
keshi = keshi + 1
Cells(1, yoko + 1).Value = keshi
For k = 1 To i - 1
For p = 1 To yoko
For q = 1 To 3
sude(i + 1 - k, p, q) = sude(i - k, p, q)
Next
Next
Next
End If
Next
Next
For i = 1 To tate
For j = 1 To yoko
Range(Cells(i, j), Cells(i, j)).Interior.Color = RGB(sude(i, j, 1), sude(i, j, 2), sude(i, j, 3))
Next
Next
End If
If keshi >= keshikazu Then
MsgBox "おめでとうございます"
Exit Sub
End If
GoTo L1
L3:
MsgBox "ゲームオーバーです。"
End Sub
Function PressCtrl() As Boolean
Const KEY_PRESSED = -32767
PressCtrl = (GetAsyncKeyState(vbKeyControl) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressZ() As Boolean
Const KEY_PRESSED = -32767
PressZ = (GetAsyncKeyState(vbKeyZ) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressX() As Boolean
Const KEY_PRESSED = -32767
PressX = (GetAsyncKeyState(vbKeyX) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressC() As Boolean
Const KEY_PRESSED = -32767
PressC = (GetAsyncKeyState(vbKeyC) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressV() As Boolean
Const KEY_PRESSED = -32767
PressV = (GetAsyncKeyState(vbKeyV) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressLeft() As Boolean
Const KEY_PRESSED = -32767
PressLeft = (GetAsyncKeyState(vbKeyLeft) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressRight() As Boolean
Const KEY_PRESSED = -32767
PressRight = (GetAsyncKeyState(vbKeyRight) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressUp() As Boolean
Const KEY_PRESSED = -32767
PressUp = (GetAsyncKeyState(vbKeyUp) And KEY_PRESSED) = KEY_PRESSED
End Function
Function PressDown() As Boolean
Const KEY_PRESSED = -32767
PressDown = (GetAsyncKeyState(vbKeyDown) And KEY_PRESSED) = KEY_PRESSED
End Function
