Excel Maniacs

成績一覧表を作る(12)

(●`ε´●)：前回から、だいぶ間があいてしまったな。みんなは

　　　　　　何をやっていたか、たぶん忘れているぞ！！

【´･ω･`】：前回は下のコードをさらにまとめるというところだった。

　　　　　　For %i = 4 TO 26 Step 2
   　　　　　　　　　　Call 教科別成績(%i)
　　　　　　Next

　　　　　　Sub 教科別成績(%列)
　　　　　　   　%科目=0
　　　　　　  　 %科目受験者=0
　　　　　　　　For %i = 8 To 52
　　                     　 %科目 = %科目 + Cells(%i, %列)
　　                      　If Cells(%i, %列) <> "" Then
                                  　%科目受験者 = %科目受験者 + 1
　　                     　End If
　　            　 Next
　　　　 　　　If %科目受験者>0 Then
　　                  　%科目平均= %科目/%科目受験者
　　           　　End If
　　           　　Cells(53,%列)=%科目
　　           　　Cells(54,%列)=%科目受験者
　　           　　Cells(55,%列)=%科目平均 
            　 End Sub

(●`ε´●)：よくみるとForループのなかでやっていることは

　　　　　　　サブルーチン教科別成績を呼び出しているだけだな。

【´･ω･`】：うん。だから、結局下のように書いてサブルーチンの部分を

　　　　　　無くしても構わない。

　　　　　　For %列 = 4 TO 26 Step 2
    　　　　　　　　%科目=0
　　　　　　　　　 %科目受験者=0
                          %科目平均=0
　　                    For %行 = 8 To 52
　　                          %科目 = %科目 + Cells(%行, %列)
　　                          If Not IsBlank(Cells(%行, %列)) Then
                                           %科目受験者 = %科目受験者 + 1
　　                           End If
　　                     Next
　　
　　                    If %科目受験者>0 Then
　　                           %科目平均= %科目/%科目受験者
　　                    End If
　　　
　　                   Cells(53,%列)=%科目
　　                   Cells(54,%列)=%科目受験者
　　                  Cells(55,%列)=%科目平均 
                 Next

(●`ε´●)：赤い部分はなんだ？

【´･ω･`】：科目ごとに変数%科目、%科目受験者 、%科目平均を

　　　　　　０に初期化するためのコードだ。

(●`ε´●)：なんでそんなものをつけるんだ？

【´･ω･`】：サブルーチン教科別成績を呼び出す形式のコードでは

　　　　　　実はあってもなくてもよかった。

(●`ε´●)：？？？

【´･ω･`】：それはサブルーチンを呼びだす度に%科目、%科目受験者 、%科目平均は

　　　　　　自動的に初期化されるからだ。しかし、そうでないときは自動的に

　　　　　　初期化されないから不具合が起こる。

(●`ε´●)：どんな？

【´･ω･`】：例えば、ある科目の受験者がゼロの場合、その前の科目の

　　　　　　データがそのまま、表示されてしまう・・・。実際に試して

　　　　　　見て欲しい・・・。

15パズル(最終回)

１５パズルもいよいよ、最終回です。今回は

完成品をアップします。遊んでみてください。

くまぷー自身、三四郎は初心者なので

「なんだこりゃ？！」と思うようなところが多々あったのでは

ないかと思います。しかし、以前にも書きましたが

Super Play Rite　の作品を公開しているサイトは少ないながらも

存在しますが、コードの解説をしているサイトは

(ほとんど）存在しないように思います。ジャストシステム自身が

Super Play Riteの普及を放棄したように思える今、そこのところに

このサイトの存在理由があります。

これからも拙いながら、三四郎マクロを公開していきます。

コメントなど頂けたら、励みになりますのでよろしくお願いいたします。

sns15PUZZLE.lzhをダウンロード

15パズル(19)

!!１５パズル　by　くまぷー
!!2007/04/23
!!All Rights Reserved
!!教員のための三四郎活用術
!!http://kumapooh.typepad.jp/

Call Init
MsgBox("パネルをシャッフルします。")
Randomize(ThisTime())
%X=5
%Y=8
for %i = 1 To 3000

　　%DX = Int(Rand() * 3)-1
　  %DY = Int(Rand() * 3)-1
　　If Abs(%DX + %DY) = 1 Then
 
　　　　 If Cells(%Y+%DY, %X+%DX) = "" Then
   　　　　　　　continue for
  　　　　Else
   　　　　　　　Cells(%Y, %X) = Cells(%Y+%DY, %X+%DX)
   　　　　　　　Cells(%Y+%DY, %X+%DX) = ""
 
   　　　　　　　%Y = %Y+%DY
   　　　　　　　%X = %X+%DX
  　　　　End If
 
　　End if
next

MsgBox("新しいゲームを始めます。")

Do While %MyKey <> "{ESC}"
　　Set %MyRange = Range?
　　%MyKey=GetKey(2,0)

　　try
　　　　%Cnt =%MyRange.Cells.Count
　　Exception
　　Case "ConstraintError"
　　　　　MsgBox("Quit")
　　　　　stop
　　end try

　　If %Cnt = 1 Then
　　　　If Row(%MyRange) > 4 And Row(%MyRange)< 9 And \\
　　　　　　Col(%MyRange)>1 And Col(%MyRange)<6 Then
　　　　　  For %dy = -1 To 1
                      For %dx = -1 To 1
                             If Abs(%dy + %dx)=1 Then
                                  If Row(%MyRange)+%dy > 4 And Row(%MyRange)+%dy< 9 And \\
　　　　　                  　     Col(%MyRange)+%dx>1 And Col(%MyRange)+%dx<6 Then
             If Cells(Row(%MyRange)+%dy, Col(%MyRange)+%dx)="" Then
                 Cells(Row(%MyRange)+%dy, Col(%MyRange)+%dx)=\\
                 Cells(Row(%MyRange), Col(%MyRange))
              Cells(Row(%MyRange), Col(%MyRange))=""
                 End If
          End If
      End If
    Next
      Next
　　　　　　If IsGameOver Then
　　　　　　　　MsgBox("Very Good!!")
　　　　　　　　Stop
　　　　　　End If
　　　　End If
　　End If
Loop

Function IsGameOver() As Boolean
　　%i=1
　　IsGameOver=True
　　For %y = 5 To 8
　　　　　For %x = 2 To 5
　　　　　　　　If %i = 16 Then
　　　　　　　　　　%i = ""

　　　　　　　　End If
　　　　　　　　If Cells(%y, %x)<> %i Then
　　　　　　　　　　IsGameOver=False
　　　　　　　　End If
　　　　　　　　%i=%i+1
　　　　　Next
　　Next
End Function

Sub Init()
　　%i=1
　　For %y = 5 To 8
　　　　　For %x = 2 To 5
　　　　　　　　If %i = 16 Then
　　　　　　　　　　%i = ""
　　　　　　　
　　　　　　　　End If
　　　　　　　　Cells(%y, %x)=%i
　　　　　　　　%i=%i+1
　　　　　Next
　　Next

End Sub

注　\\は行継続文字

　　赤字のコードはESCキー押下でゲームを中止するためのもの。

　　青字のコードはエラー対策のためのもの。