人に聞けない痔の悩み、これでスッキリ >>

今、VBでシーザー暗号の"暗号化"と"復号化"が行えるツールを作っているのですが、なかなか思うようにプログラムを組めません。
一応、以下の条件で作っています。

・アスキーコードを使用
・数値の前後のズレを任意に決められる
・暗号化(復号化)する文字の数は複数

現在のプログラム(暗号化のみ)は下記の通りです。
どうすればうまく作動するのでしょうか。
教えてください。 宜しくお願いします。


Dim strSMoji As String, strEMoji As String, length As String
Dim intSCode As Integer, intHami As Integer, counter1 As Integer, counter2 As Integer, intAmari As Integer
Dim zure01 As Double, zure02 As Double
Option Explicit


Private Sub Command1_Click() '暗号化ボタン

strSMoji = Text1.Text
counter1 = Len(strSMoji)
counter2 = Len(counter1)
intSCode = Asc(strSMoji)

Do
strSMoji = Mid(strSMoji, intSCode, [length])
If strSMoji >= 1 Then
Text1.Text = Left(strSMoji, Len(strSMoji) - 1)

If intSCode <= 121 Then '121以下であるなら
strEMoji = Chr(intSCode + zure01)
Text2.Text = strEMoji
Else
intHami = intSCode + zure01 - 97
intAmari = intHami Mod 26
strEMoji = Chr(intAmari + 97)
Text2.Text = strEMoji
End If
End If
Loop Until counter2 = counter1
End Sub


Private Sub Form_Load()
zure01 = 1
zure02 = -1
counter1 = 0
counter2 = 0
End Sub

このQ&Aに関連する最新のQ&A

A 回答 (2件)

>zure01,zure02をDoubleで宣言しているところはintegerやlongを使う方が良いのですか?


zure01,zure02は何文字分ずらすかを示す変数だと思うのですが、違いますか?そうなら値は整数しか取らないことになります。整数しかとらないのでしたら基本的には整数型か長整数型で宣言します。

初心者ならこちらの方がわかりやすいかもしれません。
Private Sub Command1_Click() '暗号化ボタン

strSMoji = Text1.Text
counter1 = Len(strSMoji)

strEMoji = ""
For i = 1 To counter1
'入力用の文字列を1文字ずつ処理します。
  intSCode = Asc(Mid(strSMoji, i, 1))
'Mid関数で1文字ずつ入力文字列を取り出し、その文字コードを得ます
  If intSCode <= 121 Then '121以下であるなら
    strEMoji = strEMoji & Chr(intSCode + zure01)
  Else
    intHami = intSCode + zure01 - 97
    intAmari = intHami Mod 26
    strEMoji = strEMoji & Chr(intAmari + 97)
  End If
Next i
'Debug.Print strSMoji; "=>"; strEMoji
Text2.Text = strEMoji
End Sub
    • good
    • 0
この回答へのお礼

rebellion様
何度も教えていただき、ありがとうございます。
細かく指導していただき、問題が解決いたしました。
迅速で丁寧な対応にとても感謝しています。
本当にありがとうございました。

お礼日時:2005/01/05 23:46

理解しがたい点が多々ありますので、一応理解できた範囲だけです。

換字のロジック自体はそのままです。
ソースだけ示されても意図がよく分からないことがあるので、言葉で説明して頂く方がよろしいかと思います。

Dim i As Long 'これをDim文の最後に追加
Option Explicit
Private Sub Command1_Click() '暗号化ボタン

strSMoji = Text1.Text
counter1 = Len(strSMoji)

strEMoji = strSMoji
'一旦出力用の文字列を入力文字列と同じにします。単に同じ長さの文字列にしたいという意図です。
For i = 1 To counter1
'入力用の文字列を1文字ずつ処理します。
  intSCode = Asc(Mid(strSMoji, i, 1))
'Mid関数で1文字ずつ入力文字列を取り出し、その文字コードを得ます
  If intSCode <= 121 Then '121以下であるなら
    Mid(strEMoji, i, 1) = Chr(intSCode + zure01)
'Mid関数で出力用文字列を1文字書き換えます
  Else
    intHami = intSCode + zure01 - 97
    intAmari = intHami Mod 26
    Mid(strEMoji, i, 1) = Chr(intAmari + 97)
  End If
Next i
'Debug.Print strSMoji; "=>"; strEMoji
Text2.Text = strEMoji
End Sub

疑問点:
zure01とzure02をDoubleで宣言しているところ(何故整数型・長整数型にしないのでしょうか?)
counter2 = Len(counter1) 何を意図しているのか理解しかねます
strSMoji = Mid(strSMoji, intSCode, [length]) 同上
If strSMoji >= 1 Then 同上
Loop Until counter2 = counter1 Doの中でcounter2を設定していないので、終了条件を満たさない(無限ループするのでは?)

また、換字の範囲チェックはもっと厳密に行うべきだと思います。(アルファベットのみに限定するのが適当かと思います)
    • good
    • 1
この回答へのお礼

迅速でご丁寧な対応、ありがとうざいます。
まだプログラムを触り始めて1ヶ月経っておらず、参考書片手に見よう見まねで組んでいるので何かと不適切な箇所も多々あるかと思います。

疑問点についてなのですが・・・
zure01,zure02をDoubleで宣言しているところはintegerやlongを使う方が良いのですか?

上記で教えて頂けたところを参考に手直ししてみます。
本当にありがとうございます。

お礼日時:2004/12/27 22:35

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Q2進数→10進数への変換 また その逆

2進数→10進数への変換 また その逆
を作成したのですが、どのようにすれば良いのでしょうか?
宜しくお願いいたします

Aベストアンサー

私も考えてみました。(マイナスについては考慮していません。)
あまりテストしてないので間違えてたらすみません。

'10進→2進
Function FromDecimalToBinary(X As Long) As String
  Dim Y As String
  If (X < 0) Then
    Y = "Error"
  Else
    Do
      Y = X Mod 2 & Y
      X = X \ 2
    Loop While (X > 0)
  End If
  FromDecimalToBinary = Y
End Function
'2進→10進
Function FromBinaryToDecimal(X As String) As Long
  Dim i As Integer
  Dim Y As Long
  '2進チェック
  If (Replace(Replace(X, "0", ""), "1", "") <> "") Then
    Y = -1
  Else
    For i = 0 To Len(X) - 1
      Y = Y + Mid(X, Len(X) - i, 1) * 2 ^ i
    Next i
  End If
  FromBinaryToDecimal = Y
End Function

Private Sub Command1_Click()
  '10進→2進
Label1 = FromDecimalToBinary(Text1)
End Sub

Private Sub Command2_Click()
  '2進→10進
Label1 = FromBinaryToDecimal(Text1)
End Sub

私も考えてみました。(マイナスについては考慮していません。)
あまりテストしてないので間違えてたらすみません。

'10進→2進
Function FromDecimalToBinary(X As Long) As String
  Dim Y As String
  If (X < 0) Then
    Y = "Error"
  Else
    Do
      Y = X Mod 2 & Y
      X = X \ 2
    Loop While (X > 0)
  End If
  FromDecimalToBinary = Y
End Function
'2進→10進
Function FromBinaryToDecimal(X As String) As Long
  Dim i As Intege...続きを読む

QExcelで五十音順に並べ替えたい

Excelで以下のような表がある場合に、五十音順に並べ替えをしたいのですがどのようなやり方で並べ替えすることができるのでしょうか?
どなたかアドバイスよろしくお願いいたします。

--------------
名称
--------------
(株)アイウエオ
(株)イノウエ
(株)ウラシマ
(株)阿部商店
(株)石井商店
(有)アイウエオ
--------------
このように文字コード順に並んでいます。これを

--------------
名称
--------------
(株)アイウエオ
(有)アイウエオ
(株)阿部商店
(株)石井商店
(株)イノウエ
(株)ウラシマ
--------------

このように”(株)”や”(有)”を抜かした五十音読み順にしたいのです。
自動ふりがな機能を使えれば簡単なのですが、データベースから貼り付けたデータなので、自動ふりがな機能は使えません。
また、諸事情でそのデータベースを操作することはできません。

Excelのバージョンは2002です。
よろしくお願いいたします。

Excelで以下のような表がある場合に、五十音順に並べ替えをしたいのですがどのようなやり方で並べ替えすることができるのでしょうか?
どなたかアドバイスよろしくお願いいたします。

--------------
名称
--------------
(株)アイウエオ
(株)イノウエ
(株)ウラシマ
(株)阿部商店
(株)石井商店
(有)アイウエオ
--------------
このように文字コード順に並んでいます。これを

--------------
名称
--------------
(株)アイウエオ
(有)アイウエオ
(株)阿部商店
(株)石井...続きを読む

Aベストアンサー

Excel VBAなら、GetPhonetic メソッドという便利なものが
あります。

これを使えば簡単にフリガナを取得できますよ。
ただし、全部が正確なフリガナを取得できるわけじゃありませんが、
手で入力するよりはよっぽど楽ですね。

QVBAでの素数の求め方

VBA初心者です。
素数を求めるプログラムを作らないといけないのですが、やり方が良く分かりません。
modやloopを使って作るのでしょうか。教えてください。

Aベストアンサー

#1です。

適当にマクロ作ったら
1~100までで26個
1~1000までで169個
1~10000までで1230個
1~30000までで3246個
だけ素数が発見できました。

1~100までは数字を直接見て確認したので。おそらく間違っていないと思います。
for文とint文と四則演算のみで簡単にできますよ。

QエクセルのVBAで画像処理? データ結果処理

エクセルのVBAでフラクタル?画像やライフゲームをしたいのですが、
どういう命令を使えば、画像が書けるのでしょうか?

また、制御系で、データ画像を表示させて、ボタンを押せばデータに基づき画像が変化するなどさせたいので、技術者向けの専門書などご存知の方教えてください。

Aベストアンサー

VBのアルゴリズム事典を本屋で探してみてください。
その中にフラクタル画像は多分載ってます。
奥村晴彦さん、河西朝雄さんの本がないか調べてください。
Visual Basicによるはじめてのアルゴリズム入門
http://7andy.yahoo.co.jp/books/detail?accd=30548708
(1)再帰処理をすると良いポピュラーな例ですので、VB(A)でどうするか勉強することが必要です。
(2)再帰処理を用いないで、同型の処理を繰り返す方法はどうするか
を勉強する必要があります。
ーー
http://www.ss.u-tokai.ac.jp/~ooya/Jugyou/5AJoronB/joron09.pdf
PASCALの例
JAVAなら
http://auction.woman.excite.co.jp/item/65250372
のような本も有るようです。アルゴリズムならC,JAVA、VBで同じですから勉強し応用できます。
ーー
ビジネス系の本には載っていない(VBの本はビジネス系が圧倒的に多い)ので、理数系の書籍に当たってみてください。

VBのアルゴリズム事典を本屋で探してみてください。
その中にフラクタル画像は多分載ってます。
奥村晴彦さん、河西朝雄さんの本がないか調べてください。
Visual Basicによるはじめてのアルゴリズム入門
http://7andy.yahoo.co.jp/books/detail?accd=30548708
(1)再帰処理をすると良いポピュラーな例ですので、VB(A)でどうするか勉強することが必要です。
(2)再帰処理を用いないで、同型の処理を繰り返す方法はどうするか
を勉強する必要があります。
ーー
http://www.ss.u-tokai.a...続きを読む

QVBでボタンを押すと画像をランダム表示させる

VisualBasic2005ExpressEditionで「ボタンを押すとピクチャーボックスに画像をランダムで表示」させたいんですが、どうやるかわかりません教えてください。何件か探しては見たんですが見つかりませんでした。もしかしてVBでは、そういったプログラムはできないんでしょうか?

Aベストアンサー

えっと、やり方は他にもあると思いますが、楽なやつで。

まず、それぞれの画像ファイルの名前を格納する配列を用意します。
Dim strPicture(10) As String
strPicture(0) = "pic1.jpg"
strPicture(1) = "pic2.jpg"
strPicture(2) = "pic3.jpg"



という風にやります。配列の数は表示させたい画像分だけ作ります。

次に、ランダムに表示させるということなので
乱数を発生させる必要がありますね。

' 0 以上 a 未満の乱数を取得する
Dim intResult As Integer = hRandom.Next(a)

とやります。 aはランダムに表示させたい画像の最大枚数-1ですね。
すると、intResultに、ランダムな数値が入ります。

そうしたら

PictureBox1.image = Image.FromFile(strPicture(intResult))

とします。

上記のコードを、ボタンをクリックしたときのイベントに追加すれば
OKです。

ただ、上記のように画像ファイル名のみだと
プログラムがあるフォルダ内に画像ファイルがないと読み込めないので
フルパスで書いた方がいいかもです。

strPicture(0) ="C:\~" という具合です。

えっと、やり方は他にもあると思いますが、楽なやつで。

まず、それぞれの画像ファイルの名前を格納する配列を用意します。
Dim strPicture(10) As String
strPicture(0) = "pic1.jpg"
strPicture(1) = "pic2.jpg"
strPicture(2) = "pic3.jpg"



という風にやります。配列の数は表示させたい画像分だけ作ります。

次に、ランダムに表示させるということなので
乱数を発生させる必要がありますね。

' 0 以上 a 未満の乱数を取得する
Dim intResult As Integer = hRandom.Next(a)

...続きを読む

QVBAで画像を表示する方法

VBA初心者です。ExcelのVBAでプログラミングの練習をしています。
早速ですが質問させてください。
ユーザーフォーム上にコマンドボタンをクリックすることにより画像を表示させることはできるのですが、これをユーザーフォームを開いた瞬間に自動的に表示させる方法はないのでしょうか?

ちなみに現在は以下のようにしています。
Private Sub CommandButton1_Click()
Image1.Picture = LoadPicture(" ")
End Sub

インターネットで調べてみても見つからないので質問させてもらいました。分かりにくい説明でしたらすみません。

Aベストアンサー

UserFormのinitializeイベントかActivateイベントを使ってください。

Private Sub UserForm_Initialize()
 Image1.Picture = LoadPicture("C:\aaa.jpg")
End Sub

または、

Private Sub UserForm_Activate()
 Image1.Picture = LoadPicture("c:\aaa.jpg")
End Sub

Q等差数列の和を求めるプログラム

初項1公差1の等差数列の第10項までSn = {1,2,3,・・・,10}の和を、while文を使って算出するプログラムを作成せよ。この様な問題があるのですが、どの様にして和をプログラムすれば良いのか分かりません。どなたか教えて頂けませんかm(_ _"m)ペコリ

Aベストアンサー

> <script language="JavaScript">

Javaじゃないでしょう・・・JavaとJavaScriptは
全く異なる言語です.

var sum;
なんで使わないの?
ヒント:sum=sum+kaunto
#変数名にはローマ字の日本語なんか使わないように
#絶対にあとになって困る.

QVBとフィボナッチに明るい方、ぜひお願いします。。

VisualBasic2008ExpressEditionにおいて、フィボナッチ数列の剰余の周期性の長さを求めるプログラムを組みましたが、一部正常に動作してくれません。詳しい方がおりましたら、修正点を教えていただけないでしょうか

先に念のため、フィボナッチ数列とその周期について説明しておきます。

まずフィボナッチ数列とは、1,1,2,3,5,8,13,21,34,55,89,144,233,377,610, のような数列のことです。
それぞれの項をある自然数で割った場合、その余りの数には特定の周期性が見られます。具体的な例でいくと、例えば5でそれぞれの項を割り、その余りを書き下していくと

1,1,2,3,0,3,3,1,4,0,4,4,3,2,0,2,2,4,1,0, 1,1,2,3,0,3…

と、あるところから先はそれまでの列の繰り返しになります。この場合、ひと周期の長さは20ということになります。


今回組んだ以下のプログラムは、上記の例のように何らかの自然数でフィボナッチ数列の各項を割った場合、その周期の長さがどうなるかを求めるプログラムです。
しかし、どこかに間違いがあるようで、周期の長さが80以上になるような場合であると、正常に動作してくれません。残念ながら私ではその原因が分からないので、
もしよろしければ修正すべき点を教えていただけないでしょうか? よろしくお願いいたします。。

Public Class Form1

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

Dim a(1000), b(1000), c, n, x


a(1) = 1 : a(2) = 1 : n = 2

x = Val(TextBox1.Text)

Do

n = n + 1

Label1.Text = n

a(n) = a(n - 2) + a(n - 1)

Label2.Text = a(n)

b(n) = a(n) Mod x

Label3.Text = b(n)

a(n + 1) = a(n - 1) + a(n)

Label4.Text = a(n + 1)

b(n + 1) = a(n + 1) Mod x

Label5.Text = b(n + 1)

If b(n) * b(n + 1) = 1 Then

c = n - 1

Exit Do

End If

Loop

Label6.Text = c

End Sub
End Class

VisualBasic2008ExpressEditionにおいて、フィボナッチ数列の剰余の周期性の長さを求めるプログラムを組みましたが、一部正常に動作してくれません。詳しい方がおりましたら、修正点を教えていただけないでしょうか

先に念のため、フィボナッチ数列とその周期について説明しておきます。

まずフィボナッチ数列とは、1,1,2,3,5,8,13,21,34,55,89,144,233,377,610, のような数列のことです。
それぞれの項をある自然数で割った場合、その余りの数には特定の周期性が見られます。具体的な例でいくと、例えば5...続きを読む

Aベストアンサー

もう見ていないかもしれませんが、さらなる改善案を思いついたので一応。
もともとのプログラムは私のも含めて、一回のループに2回数列計算をしていますが、はじめの計算は前回のループの後半に行ったものと同じなので無駄ですね。

なので、それを省き、かつ、途中経過のTextBoxへの書き込みを省いてみたところ、100,000,000(一億) でも数秒でできましたので一応報告します。

Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Dim a(3), c, n, x As Integer

a(1) = 1 : a(2) = 1 : n = 2

x = Val(TextBox1.Text)

Do

n = n + 1

a(3) = (a(1) + a(2)) Mod x

If a(2) = 1 AndAlso a(3) = 1 Then

c = n - 2

Exit Do

End If

a(1) = a(2)
a(2) = a(3)

Loop

Label6.Text = c

End Sub

なお、もう一桁多くすると、
Integerの限界を超えてしまうので、最初の宣言文のIntegerを
Longに変えてください。
なお、いっそのこととDecimalにしてしまうと、
急激に遅くなりますのでご注意を。

しかし、10進数できりのいい数値を入れると、
必ずきりのいい数値が求まるんですけど、
なんでなんですかねー。不思議です。
それこそ、だれかこの数列に詳しい人に聞いてみたいです。

100 →  300
1000 →  1500
10000 →  15000
100000 →  150000
1000000 → 1500000

もう見ていないかもしれませんが、さらなる改善案を思いついたので一応。
もともとのプログラムは私のも含めて、一回のループに2回数列計算をしていますが、はじめの計算は前回のループの後半に行ったものと同じなので無駄ですね。

なので、それを省き、かつ、途中経過のTextBoxへの書き込みを省いてみたところ、100,000,000(一億) でも数秒でできましたので一応報告します。

Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
...続きを読む

Q奇数・偶数の判断 VBA

Sub Macro1()
Dim i As Long
i = 1
For i = 1 To 10

If i = ? Then '偶数ならと言うコード
MsgBox "偶数です"
Else
MsgBox "奇数です"
End If

Next
End Sub

ここまでは自分で作れたのですが、iが奇数か偶数かを判断するコードがわかりません。
ご教授よろしくお願いします。

Aベストアンサー

やりようは幾らでもありますが、たとえば

sub macro1()
 dim i
 for i=1 to 10
 if i mod 2 = 0 then
  msgbox i & " is even"
 else
  msgbox i & " is odd"
 end if
 next i
end sub


他にも、WorksheetfunctionのOddとかEvenとか使ってみたり、単純に2で割り算した答えがどうかとか。

QExcel VBAライフゲーム

ExcelのVBAでライフゲームを作りたいのですが、次のプログラムの途中以降がわかりません。
もしよろしければ、このつづきの簡単な実行できるVBAライフゲームを教えてください。
続きのプログラムを教えていただけたら幸いです。

Option Explicit

Const ALIVE As Integer = 1
Const DEAD As Integer = 0

Const SIZE As Integer = 19
Const Tmax As Integer = 100

Dim C(SIZE, SIZE) As Integer

Sub LifeGame()
Dim InitRate As Single
Dim T As Integer
Dim N As Integer
Dim Cnext(SIZE, SIZE) As Integer
Dim I As Integer, J As Integer

InitRate = -1
Do While InitRate < 0 Or 1 < InitRate
Loop

For I = 0 To SIZE
For J = 0 To SIZE
If Rnd() < InitRate Then
C(I, J) = ALIVE
Else
C(I, J) = DEAD
End If
Next J
Next I

For T = 1 To Tmax

For I = 0 To SIZE
For J = 0 To SIZE
If C(I, J) = ALIVE Then
Cells(I + 1, J + 1).Value = "■"
Else
Cells(I + 1, J + 1).Vallue = ""
End If
Next J
Next I

For I = 0 To SIZE
For J = 0 To SIZE
N = Count(I, J)

Next J
Next I

For I = 0 To SIZE
For J = 0 To SIZE
C(I, J) = Cnext(I, J)
Next J
Next I

Next T

End Sub

Function Count(I As Integer, J As Integer) As Integer

End Function

ExcelのVBAでライフゲームを作りたいのですが、次のプログラムの途中以降がわかりません。
もしよろしければ、このつづきの簡単な実行できるVBAライフゲームを教えてください。
続きのプログラムを教えていただけたら幸いです。

Option Explicit

Const ALIVE As Integer = 1
Const DEAD As Integer = 0

Const SIZE As Integer = 19
Const Tmax As Integer = 100

Dim C(SIZE, SIZE) As Integer

Sub LifeGame()
Dim InitRate As Single
Dim T As Integer
Dim N As Integer
Dim Cnext(SIZE, SIZE) As Integer
Di...続きを読む

Aベストアンサー

このままの形を残して作ると無駄が多すぎるのと、画面表示が遅すぎるので、多少変更、削除しました。
コードはWorkbookに貼り付ける事を前提に作ってあります。
選択済み以外のセルをクリックするとスタートします。

ルールはWikiの内容を参考にしました。BORNとLIFEの値(0~8の範囲)を変更するとパターンも変わります。

http://ja.wikipedia.org/wiki/%E3%83%A9%E3%82%A4%E3%83%95%E3%82%B2%E3%83%BC%E3%83%A0

Option Explicit

Const ALIVE As Integer = 1
Const DEAD As Integer = 0
Const BORN As Integer = 3 '加筆
Const LIFE As Integer = 2 '加筆

Const SIZE As Integer = 20 '19を20に変更
Const Tmax As Integer = 100

Dim C(SIZE, SIZE) As Integer
Dim Xrange As Variant '加筆

Private Sub LifeGame()   'Private
Dim InitRate As Single
Dim T As Integer
'Dim N As Integer 不要
'Dim Cnext(SIZE, SIZE) As Integer 不要
Dim I As Integer, J As Integer

Randomize '加筆
Xrange = Range("A1:T20") '加筆

InitRate = 0.5  '-1を0.5に変更
'Do While InitRate < 0 Or 1 < InitRate 不要
'Loop

For I = 1 To SIZE   '初期値0を1に変更
For J = 1 To SIZE   '初期値0を1に変更
If Rnd() < InitRate Then
C(I, J) = ALIVE
Else
C(I, J) = DEAD
End If
Next J
Next I

For T = 1 To Tmax

For I = 1 To SIZE  '初期値0を1に変更
For J = 1 To SIZE   '初期値0を1に変更
If C(I, J) = ALIVE Then
Xrange(I, J) = "■"  '訂正
Else
Xrange(I, J) = "" '訂正
End If
Next J
Next I

Range("A1:T20") = Xrange '加筆

' For I = 0 To SIZE   不要
' For J = 0 To SIZE
' N = Count(I, J)
' Next J
' Next I

For I = 1 To SIZE  '初期値0を1に変更
For J = 1 To SIZE   '初期値0を1に変更
C(I, J) = Cnext(I, J)
Next J
Next I

Next T

End Sub

Function Cnext(I As Integer, J As Integer) As Integer  'Function名変更
Dim xi As Integer
Dim xj As Integer
Dim xsum As Integer

For xi = I - 1 To I + 1
For xj = J - 1 To J + 1
If (xi > 0 And xi <= SIZE) _
And (xj > 0 And xj <= SIZE) Then
If Not (xi = I And xj = J) Then
If C(xi, xj) = ALIVE Then
xsum = xsum + 1
End If
End If
End If
Next
Next

Select Case xsum
Case BORN
Cnext = ALIVE
Case LIFE
Cnext = C(I, J)
Case Else
Cnext = DEAD
End Select

End Function

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call LifeGame
End Sub

このままの形を残して作ると無駄が多すぎるのと、画面表示が遅すぎるので、多少変更、削除しました。
コードはWorkbookに貼り付ける事を前提に作ってあります。
選択済み以外のセルをクリックするとスタートします。

ルールはWikiの内容を参考にしました。BORNとLIFEの値(0~8の範囲)を変更するとパターンも変わります。

http://ja.wikipedia.org/wiki/%E3%83%A9%E3%82%A4%E3%83%95%E3%82%B2%E3%83%BC%E3%83%A0

Option Explicit

Const ALIVE As Integer = 1
Const DEAD As Integer = 0
Const BORN...続きを読む


人気Q&Aランキング