上級91回のコード

メイン

#If Win64 Then
   Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
   Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Dim cards(1 To 18)
Public cnt As Long 'カードをめくった回数
Sub Init()
   Dim i As Integer
   Dim j As Integer
   Dim r As Integer
   Dim c As Integer
   Dim x As Integer
   
   Randomize
   
   
   cnt = 0
   
   '1～9を2個ずつ配列に入れる
   For j = 0 To 1
   
       For i = 1 To 9
       
           cards(i + 9 * j) = i
           
       Next
       
   Next
   
   c = 0
   
   'カードを並べる
   For j = 0 To 2
   
       For i = 0 To 5
       
           r = Int((18 - c) * Rnd + 1)
           
           Range("b2").Offset(j, i) = cards(r)
           Range("b2").Offset(j, i).Interior.Color = RGB(255, 0, 0)
           
           For x = r To 17
               cards(x) = cards(x + 1)
           Next x
           
           c = c + 1
           
       Next i
       
   Next j
   
End Sub
Sub Reverse(Target As Range)
   Dim ac(0 To 1) As Range
   Dim num As Integer
   Dim compFG As Boolean
   
   If Target.Interior.Color = RGB(255, 0, 0) Then
   
       Target.Interior.Color = RGB(255, 255, 255)
       
       cnt = cnt + 1
       
       If cnt Mod 2 = 0 Then
       
           Sleep 1000
           
           compFG = True
           
           num = 0
           
           For j = 0 To 2
           
               For i = 0 To 5
                   
                   If Range("b2").Offset(j, i).Interior.Color = RGB(255, 255, 255) Then
                       
                       Set ac(num) = Range("b2").Offset(j, i)
                       num = 1
                       
                   End If
                   
                   If Range("b2").Offset(j, i).Interior.Color = RGB(255, 0, 0) Then
                       '赤色が一つでもあればクリアにならない
                       compFG = False
                       
                   End If
                   
               Next i
               
           Next j
           
           '同じ数字なら
           If ac(0).Value = ac(1).Value Then
           
               ac(0).Interior.Color = RGB(150, 150, 150)
               ac(1).Interior.Color = RGB(150, 150, 150)
           
           Else
           
               ac(0).Interior.Color = RGB(255, 0, 0)
               ac(1).Interior.Color = RGB(255, 0, 0)
           
           End If
           
           If compFG Then
           
               MsgBox "クリアー！！！"
               Call Init
               
           End If
           
       End If
   End If
End Sub

Sub 例題()
   
   Dim moji(1 To 5)
   
   moji(1) = "A"
   moji(2) = "B"
   moji(3) = "C"
   moji(4) = "D"
   moji(5) = "E"
   
   Dim i As Integer
   Dim j As Integer
   Dim r As String
       
   For i = 1 To 5
   
       r = Int((6 - i) * Rnd + 1)
       
       MsgBox moji(r)
       
       For j = r To 4
           moji(j) = moji(j + 1)
       Next j
       
   Next i
   
End Sub

プライベートSub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   '行列がエリア内か判定
   If Target.Row > 1 And Target.Row < 5 Then
       
       If Target.Column > 1 And Target.Column < 8 Then
           
           'アクティブセルが１つだけなら
           If Target.Count = 1 Then
           
               Call Reverse(Target)
               
           End If
       
       End If
   End If
   
   Range("a1").Activate
End Sub