| 問題解き エクセルで遊ぼう 作画 製本 問題 作曲 |
川渡り1「キャベツ・羊・狼・狩人の川渡り」船の定員は2名（キャベツや動物も1名と数えて)で、漕げるのは狩人だけ。 禁則： ・キャベツと羊だけがいっしょにいる ・狼と羊だけがいっしょにいる ・キャベツと羊と狼だけがいっしょにいる 計算方法は、２進法を用い、なし=0、キャベツ=1、羊=2、狼=4、狩人=8で計算すると、例えば合計10だったら羊と狩人だと分かる。 禁則のケースを避け、あと、計算の効率化のため船の移動の行き帰りで船のメンバーが同じケースを避けた。 A列をこちら岸、B列を船、C列を対岸として、それぞれメンバーの数値の合計で表現した。A列が0、C列が15になれば成功だ。 禁則をe(0〜2)、各メンバーがこちら岸にいる状態をh(0〜4)=trueで表すことにした（falseなら対岸にいる）。 
Option Explicit Sub kawa1() Dim i, j, k, x(4), e(2) As Integer Dim h(4) As Boolean Columns("a:c").ClearContents x(0) = 0: x(1) = 1: x(2) = 2: x(3) = 4: x(4) = 8 e(0) = 3: e(1) = 6: e(2) = 7 For i = 0 To 4 h(i) = True Next i k = 1 Cells(k, 1) = 15 Cells(k, 3) = 0 '渡る 100 For i = 0 To 3 If (h(i) = False) Or (x(4) + x(i) = Cells(k, 2)) Then GoTo 500 For j = 0 To 2 If Cells(k, 1) - x(4) - x(i) = e(j) Then GoTo 500 Next j k = k + 1 Cells(k, 2) = x(4) + x(i) Cells(k, 1) = Cells(k - 1, 1) - Cells(k, 2) Cells(k, 3) = Cells(k - 1, 3) + Cells(k, 2) h(4) = False h(i) = False h(0) = False GoTo 600 500 Next i Exit Sub '判定 600 If Cells(k, 3) = 15 Then Exit Sub '戻る For i = 0 To 3 If (h(i) = True) Or (x(4) + x(i) = Cells(k, 2)) Then GoTo 700 For j = 0 To 2 If Cells(k, 3) - x(4) - x(i) = e(j) Then GoTo 700 Next j k = k + 1 Cells(k, 2) = x(4) + x(i) Cells(k, 1) = Cells(k - 1, 1) + Cells(k, 2) Cells(k, 3) = Cells(k - 1, 3) - Cells(k, 2) h(4) = True h(i) = True h(0) = True GoTo 100 700 Next i End Sub |
川渡り2「8人家族の川渡り」娘a・娘b・息子a・息子b・母・父・メイド・犬の家族。 船の定員は2名(犬も1名と数える）で、漕げるのは母と父とメイドだけ。 禁則： ・娘aまたは娘bが母のいないとき父といっしょにいる（けんかする？） ・息子aまたは息子bが父のいないとき母といっしょにいる（けんかする？） ・メイドのいないとき犬が誰かといる(噛まれる？) 計算方法は、またもや２進法を用い、なし=0、娘a=1、娘b=2、息子a=4、息子b=8、母=16、父=32、メイド=64、犬=128で計算すると、例えば合計18だったら母と娘bだと分かる。 禁則のケースを避け、あと、計算の効率化のため、いちばん最初はメイドと犬で渡り、船の移動の行き帰りで船のメンバーが同じケースを避けた。 A列をこちら岸、B列を船、C列を対岸として、それぞれメンバーの数値の合計で表現した。A列が0、C列が255になれば成功で、セルD1に「おめでとう」と表示する。 禁則をer、各メンバーがこちら岸にいる状態をh(0〜8)=trueで表すことにした（falseなら対岸にいる）。繰り返しの部分はサブルーチンにした。 
Option Explicit Sub kawa2() Dim i, j, k, r, s, x(8), xx, ii, jj ,n As Integer Dim h(8), er As Boolean '0なし 1娘a 2娘b 3息子a 4息子b 5母 6父 7メイド 8犬 x(0) = 0: x(1) = 1: x(2) = 2: x(3) = 4: x(4) = 8 x(5) = 16: x(6) = 32: x(7) = 64: x(8) = 128 For n = 1 To 100 Columns("a:d").ClearContents For i = 0 To 8 h(i) = True Next i k = 1 Cells(k, 1) = 255 Cells(k, 3) = 0 '渡る 100 r = Int(Rnd(1) * 3) + 5 If k = 1 Then r = 7 For i = r To r + 2 ii = i: If ii > 7 Then ii = ii - 3 s = Int(Rnd(1) * 9) If k = 1 Then s = 8 For j = s To s + 8 jj = j: If jj > 8 Then jj = jj - 9 If (h(ii) = False) Or (h(jj) = False) Or (ii = jj) Then GoTo 500 If x(jj) + x(ii) = Cells(k, 2) Then GoTo 500 xx = Cells(k, 1) - x(ii) - x(jj) GoSub 800: If er = True Then GoTo 500 xx = Cells(k, 3) + x(ii) + x(jj) GoSub 800: If er = True Then GoTo 500 xx = x(ii) + x(jj) If (xx = 33) Or (xx = 34) Or (xx = 20) Or (xx = 24) Or (xx = 144) Or (xx = 160) Then GoTo 500 k = k + 1 Cells(k, 2) = x(ii) + x(jj) Cells(k, 1) = Cells(k - 1, 1) - Cells(k, 2) Cells(k, 3) = Cells(k - 1, 3) + Cells(k, 2) h(ii) = False h(jj) = False h(0) = False GoTo 600 500 Next j Next i GoTo 750 Exit Sub '判定 600 If Cells(k, 3) = 255 Then Cells(1, 4) = n & "おめでとう" Exit Sub End If '戻る r = Int(Rnd(1) * 3) + 5 For i = r To r + 2 ii = i: If ii > 7 Then ii = ii - 3 s = Int(Rnd(1) * 9) For j = s To s + 8 jj = j: If jj > 8 Then jj = jj - 9 If (h(ii) = True) Or (h(jj) = True) Or (ii = jj) Then GoTo 700 If x(jj) + x(ii) = Cells(k, 2) Then GoTo 700 xx = Cells(k, 1) + x(ii) + x(jj) GoSub 800: If er = True Then GoTo 700 xx = Cells(k, 3) - x(ii) - x(jj) GoSub 800: If er = True Then GoTo 700 xx = x(ii) + x(jj) If (xx = 33) Or (xx = 34) Or (xx = 20) Or (xx = 24) Or (xx = 144) Or (xx = 160) Then GoTo 700 k = k + 1 Cells(k, 2) = x(ii) + x(jj) Cells(k, 1) = Cells(k - 1, 1) + Cells(k, 2) Cells(k, 3) = Cells(k - 1, 3) - Cells(k, 2) h(ii) = True h(jj) = True h(0) = True GoTo 100 700 Next j Next i 750 Next n Exit Sub 800 If ((xx And x(1)) = x(1)) And ((xx And x(5)) = 0) And ((xx And x(6)) = x(6)) Then er = True ElseIf ((xx And x(2)) = x(2)) And ((xx And x(5)) = 0) And ((xx And x(6)) = x(6)) Then er = True ElseIf ((xx And x(3)) = x(3)) And ((xx And x(5)) = x(5)) And ((xx And x(6)) = 0) Then er = True ElseIf ((xx And x(4)) = x(4)) And ((xx And x(5)) = x(5)) And ((xx And x(6)) = 0) Then er = True ElseIf ((xx And x(7)) = 0) And (xx > x(8)) Then er = True Else er = False End If Return End Sub なお、計算する組み合わせが多く、なかなか解けないため、コマンドボタンを１回押すと１００回実行するように改良した（解ければ即終了、おめでとうの前に回数を表示）。 |
川渡り3「ウサギ３匹、犬３匹の川渡り」船の定員は2名(動物だが1名と数える）で、全員漕げる。 禁則: ウサギが犬の数より少ない状態（噛まれる？） 計算方法は、またもや２進法を用い、なし=0、ウサギa=1、ウサギb=2、ウサギc=4、犬a=8、犬b=16、犬c=32で計算すると、例えば合計１２だったら犬aとウサギcだと分かる。 禁則のケースを避け、あと、計算の効率化のため船の移動の行き帰りで船のメンバー（動物の種類）が同じケースを避けた。 A列をこちら岸、B列を船、C列を対岸として、それぞれメンバーの数値の合計で表現した。D列には船に乗った動物の種類が簡単に分かる値を入れた(ウサギを１、犬を３とした合計。合計２ならウサギ２匹、合計４ならウサギと犬だと分かる)。 A列が0、C列が63になれば成功で、セルD1に「おめでとう」と表示する。 禁則をe(0〜14)、各メンバーがこちら岸にいる状態をh(0〜6)=trueで表すことにした（falseなら対岸にいる）。 
Option Explicit Sub kawa3() Dim i, j, k, m, n, x(6), y(6), rr, ss, ii, jj, e(14) As Integer Dim h(6) As Boolean Columns("a:d").ClearContents x(0) = 0: x(1) = 1: x(2) = 2: x(3) = 4: x(4) = 8: x(5) = 16: x(6) = 32 y(0) = 0: y(1) = 1: y(2) = 1: y(3) = 1: y(4) = 3: y(5) = 3: y(6) = 3 e(0) = 57: e(1) = 58: e(2) = 60: e(3) = 59: e(4) = 61 e(5) = 62: e(6) = 25: e(7) = 26: e(8) = 28: e(9) = 41 e(10) = 42: e(11) = 44: e(12) = 49: e(13) = 50: e(14) = 52 For i = 0 To 6 h(i) = True Next k = 1 Cells(k, 1) = 63 Cells(k, 3) = 0 '渡る 100 rr = Int(Rnd(1) * 6) + 1 For i = rr To rr + 5 ii = i: If ii > 6 Then ii = ii - 6 If h(ii) = True Then ss = Int(Rnd(1) * 7) For j = ss To ss + 6 jj = j: If jj > 6 Then jj = jj - 7 If (h(jj) = False) Or (y(ii) + y(jj) = Cells(k, 4)) Or (ii = jj) Then GoTo 500 For n = 0 To 14 If Cells(k, 1) - x(ii) - x(jj) = e(n) Then GoTo 500 If Cells(k, 3) + x(ii) + x(jj) = e(n) Then GoTo 500 Next n k = k + 1 Cells(k, 2) = x(ii) + x(jj) Cells(k, 1) = Cells(k - 1, 1) - Cells(k, 2) Cells(k, 3) = Cells(k - 1, 3) + Cells(k, 2) Cells(k, 4) = y(ii) + y(jj) h(ii) = False h(jj) = False h(0) = False GoTo 600 500 Next j End If Next i Exit Sub '判定 600 If Cells(k, 3) = 63 Then Cells(1, 4) = "おめでとう" Exit Sub End If '戻る rr = Int(Rnd(1) * 6) + 1 For i = rr To rr + 5 ii = i: If ii > 6 Then ii = ii - 6 If h(ii) = False Then ss = Int(Rnd(1) * 7) For j = ss To ss + 6 jj = j: If jj > 6 Then jj = jj - 7 If (h(jj) = True) Or (y(ii) + y(jj) = Cells(k, 4)) Or (ii = jj) Then GoTo 700 For n = 0 To 14 If Cells(k, 3) - x(ii) - x(jj) = e(n) Then GoTo 700 If Cells(k, 1) + x(ii) + x(jj) = e(n) Then GoTo 700 Next n k = k + 1 Cells(k, 2) = x(ii) + x(jj) Cells(k, 1) = Cells(k - 1, 1) + Cells(k, 2) Cells(k, 3) = Cells(k - 1, 3) - Cells(k, 2) Cells(k, 4) = y(ii) + y(jj) h(ii) = True h(jj) = True h(0) = True GoTo 100 700 Next j End If Next i End Sub |
川渡り4「夫婦３組の川渡り」船の定員は2名で、全員漕げる。 禁則： 妻は夫がいないときに他の夫といっしょにいるのはダメ（やきもち？）。 計算方法は、2進法を用い、なし=0、妻a=1、妻b=2、妻c=4、夫a=8、夫b=16、夫c=32で計算すると、例えば合計36だったら妻cと夫cだと分かる。夫a妻a、夫b妻b、夫c妻cは夫婦だ。 禁則のケースを避け、あと、計算の効率化のため船の移動の行き帰りで船のメンバーが同じケースを避けた。 A列をこちら岸、B列を船、C列を対岸として、それぞれメンバーの数値の合計で表現した。 A列が0、C列が63になれば成功で、セルD1に「おめでとう」と表示する。 禁則をer、各メンバーがこちら岸にいる状態をh(0〜6)=trueで表すことにした（falseなら対岸にいる）。 
Option Explicit Sub kawa4() Dim i, j, k, n, x(6), rr, ss, ii, jj, z1, z2, z3 As Integer Dim h(6), er As Boolean Columns("a:d").ClearContents x(0) = 0: x(1) = 1: x(2) = 2: x(3) = 4: x(4) = 8: x(5) = 16: x(6) = 32 For i = 0 To 6 h(i) = True Next k = 1 Cells(k, 1) = 63 Cells(k, 3) = 0 '渡る 100 rr = Int(Rnd(1) * 6) + 1 For i = rr To rr + 5 ii = i: If ii > 6 Then ii = ii - 6 If h(ii) = True Then ss = Int(Rnd(1) * 7) For j = ss To ss + 6 jj = j: If jj > 6 Then jj = jj - 7 If (h(jj) = False) Or (x(ii) + x(jj) = Cells(k, 2)) Or (ii = jj) Then GoTo 500 GoSub 900: If er = True Then GoTo 500 k = k + 1 Cells(k, 2) = x(ii) + x(jj) Cells(k, 1) = Cells(k - 1, 1) - Cells(k, 2) Cells(k, 3) = Cells(k - 1, 3) + Cells(k, 2) h(ii) = False h(jj) = False h(0) = False GoTo 600 500 Next j End If Next i Exit Sub '判定 600 If Cells(k, 3) = 63 Then Cells(1, 4) = "おめでとう" Exit Sub End If '戻る rr = Int(Rnd(1) * 6) + 1 For i = rr To rr + 5 ii = i: If ii > 6 Then ii = ii - 6 If h(ii) = False Then ss = Int(Rnd(1) * 7) For j = ss To ss + 6 jj = j: If jj > 6 Then jj = jj - 7 If (h(jj) = True) Or (x(ii) + x(jj) = Cells(k, 2)) Or (ii = jj) Then GoTo 700 GoSub 900: If er = True Then GoTo 700 k = k + 1 Cells(k, 2) = x(ii) + x(jj) Cells(k, 1) = Cells(k - 1, 1) + Cells(k, 2) Cells(k, 3) = Cells(k - 1, 3) - Cells(k, 2) h(ii) = True h(jj) = True h(0) = True GoTo 100 700 Next j End If Next i Exit Sub 900 z1 = x(ii) + x(jj) z2 = Cells(k, 1) - z1 z3 = Cells(k, 3) + z1 If (z1 = 17) Or (z1 = 33) Or (z1 = 10) Or (z1 = 34) Or (z1 = 12) Or (z1 = 20) Then er = True ElseIf ((z2 And x(1)) = x(1)) And ((z2 And x(4)) = 0) And (((z2 And x(5)) = x(5)) Or ((z2 And x(6)) = x(6))) Then er = True ElseIf ((z2 And x(2)) = x(2)) And ((z2 And x(5)) = 0) And (((z2 And x(4)) = x(4)) Or ((z2 And x(6)) = x(6))) Then er = True ElseIf ((z2 And x(3)) = x(3)) And ((z2 And x(6)) = 0) And (((z2 And x(4)) = x(4)) Or ((z2 And x(5)) = x(5))) Then er = True ElseIf ((z3 And x(1)) = x(1)) And ((z3 And x(4)) = 0) And (((z3 And x(5)) = x(5)) Or ((z3 And x(6)) = x(6))) Then er = True ElseIf ((z3 And x(2)) = x(2)) And ((z3 And x(5)) = 0) And (((z3 And x(4)) = x(4)) Or ((z3 And x(6)) = x(6))) Then er = True ElseIf ((z3 And x(3)) = x(3)) And ((z3 And x(6)) = 0) And (((z3 And x(4)) = x(4)) Or ((z3 And x(5)) = x(5))) Then er = True Else er = False End If Return End Sub |
川渡り5「１０人家族の川渡り」犬も一人と数えて娘a、娘b、息子a、息子b、母、父、メイド、爺、赤ちゃん、犬の10人家族。 船の定員は2名で、大人だけ漕げる。 禁則 ・母がいないときに父と娘をいっしょにいさせる（けんかする？） ・父がいないときに母と息子をいっしょにいさせる（けんかする？） ・親がいないときに爺と「娘または息子または赤ちゃん」をいっしょにいさせる（けんかする？） ・親がいないときに「娘または息子」と赤ちゃんをいっしょにいさせる（けんかする？） ・メイドがいないときに犬とだれかとをいっしょにいさせる（噛まれる？） 計算方法は、２進法を用い、なし=0、娘a=1、娘b=2、息子a=4、息子b=8、母=16、父=32、メイド=64、爺=128、赤ちゃん=256、犬=512で計算すると、例えば合計578だったらメイドと犬だと分かる。 禁則のケースを避け、あと、計算の効率化のため、下記のようにした。 ・いちばん最初は、メイドと犬で渡る。 ・船の移動の行き帰りで船のメンバーが同じケースを避ける。 ・子ども（娘・息子・赤ちゃん）を帰りの船に乗せない。 ・こちら岸に子ども一人だけになったらメイドと犬で迎えに来る。 ・こちら岸に犬だけになったらメイドだけで迎えに来る。 ・こちら岸の状態（ボートの位置を含む）が以前と同じになるのはなるべく避ける。 A列をこちら岸、B列を船、C列を対岸として、それぞれメンバーの数値の合計で表現した。 A列が0、C列が1023になれば成功で、セルD1に「おめでとう」と表示する。 禁則をer、各メンバーがこちら岸にいる状態をh(0〜10)=trueで表すことにした（falseなら対岸にいる）。 なお、計算する組み合わせが多く、なかなか解けないため、コマンドボタンを１回押すと１００回実行するようにした（解ければ即終了、おめでとうの前に回数を表示）。 
Option Explicit Sub kawa5() Dim i, j, k, r, s, x(10), xx, ii, jj, m, n As Integer Dim h(10), er As Boolean x(0) = 0: x(1) = 1: x(2) = 2: x(3) = 4: x(4) = 8 x(5) = 16: x(6) = 32: x(7) = 64: x(8) = 128: x(9) = 256: x(10) = 512 For n = 1 To 100 Columns("a:d").ClearContents For i = 0 To 10 h(i) = True Next i k = 1 Cells(k, 1) = 1023 Cells(k, 3) = 0 '渡る 100 r = Int(Rnd(1) * 4) + 5 For i = r To r + 3 ii = i: If ii > 8 Then ii = ii - 4 s = Int(Rnd(1) * 11) For j = s To s + 10 jj = j: If jj > 10 Then jj = jj - 11 If k = 1 Then ii = 7: jj = 10 GoTo 450 End If If (h(ii) = False) Or (h(jj) = False) Or (ii = jj) Then GoTo 500 If x(jj) + x(ii) = Cells(k, 2) Then GoTo 500 GoSub 900: If er = True Then GoTo 500 xx = Cells(k, 1) - x(ii) - x(jj) GoSub 800: If er = True Then GoTo 500 xx = Cells(k, 3) + x(ii) + x(jj) GoSub 800: If er = True Then GoTo 500 xx = x(ii) + x(jj) If (xx = 33) Or (xx = 34) Or (xx = 20) Or (xx = 24) Or (xx = 528) Or (xx = 544) Or (xx = 640) _ Or (xx = 129) Or (xx = 130) Or (xx = 132) Or (xx = 136) Or (xx = 384) Then GoTo 500 450 k = k + 1 Cells(k, 2) = x(ii) + x(jj) Cells(k, 1) = Cells(k - 1, 1) - Cells(k, 2) Cells(k, 3) = Cells(k - 1, 3) + Cells(k, 2) h(ii) = False h(jj) = False h(0) = False GoTo 600 500 Next j Next i GoTo 750 '判定 600 If Cells(k, 3) = 1023 Then Cells(1, 4) = n & "おめでとう" Exit Sub End If '戻る r = Int(Rnd(1) * 4) + 5 For i = r To r + 3 ii = i: If ii > 8 Then ii = ii - 4 s = Int(Rnd(1) * 11) For j = s To s + 10 jj = j: If jj > 10 Then jj = jj - 11 If (h(ii) = True) Or (h(jj) = True) Or (ii = jj) Then GoTo 700 If (Cells(k, 1) = 1) Or (Cells(k, 1) = 2) Or (Cells(k, 1) = 4) Or (Cells(k, 1) = 8) Or (Cells(k, 1) = 256) Then ii = 7: jj = 10 GoTo 650 ElseIf Cells(k, 1) = 512 Then ii = 7: jj = 0 GoTo 650 End If If (jj = 1) Or (jj = 2) Or (jj = 3) Or (jj = 4) Or (jj = 9) Then GoTo 700 If x(jj) + x(ii) = Cells(k, 2) Then GoTo 700 GoSub 950: If er = True Then GoTo 700 xx = Cells(k, 1) + x(ii) + x(jj) GoSub 800: If er = True Then GoTo 700 xx = Cells(k, 3) - x(ii) - x(jj) GoSub 800: If er = True Then GoTo 700 xx = x(ii) + x(jj) 650 k = k + 1 Cells(k, 2) = x(ii) + x(jj) Cells(k, 1) = Cells(k - 1, 1) + Cells(k, 2) Cells(k, 3) = Cells(k - 1, 3) - Cells(k, 2) h(ii) = True h(jj) = True h(0) = True GoTo 100 700 Next j Next i 750 Next n Exit Sub 800 If (((xx And x(1)) = x(1)) Or ((xx And x(2)) = x(2))) And ((xx And x(5)) = 0) And ((xx And x(6)) = x(6)) Then er = True ElseIf (((xx And x(3)) = x(3)) Or ((xx And x(4)) = x(4))) And ((xx And x(5)) = x(5)) And ((xx And x(6)) = 0) Then er = True ElseIf ((xx And x(8)) = x(8)) And ((xx And x(5)) = 0) And ((xx And x(6)) = 0) And _ (((xx And x(1)) = x(1)) Or ((xx And x(2)) = x(2)) Or ((xx And x(3)) = x(3)) Or ((xx And x(4)) = x(4)) Or ((xx And x(9)) = x(9))) Then er = True ElseIf ((xx And x(5)) = 0) And ((xx And x(6)) = 0) And ((xx And x(9)) = x(9)) And _ (((xx And x(1)) = x(1)) Or ((xx And x(2)) = x(2)) Or ((xx And x(3)) = x(3)) Or ((xx And x(4)) = x(4))) Then er = True ElseIf ((xx And x(7)) = 0) And (xx > x(10)) Then er = True Else er = False End If Return 900 For m = 1 To k Step 2 If (Cells(m, 3) = Cells(k, 3) + x(ii) + x(jj)) And (Rnd(1) > 0.9) Then er = True Return Else er = False End If Next m Return 950 For m = 2 To k Step 2 If (Cells(m, 1) = Cells(k, 1) + x(ii) + x(jj)) And (Rnd(1) > 0.9) Then er = True Return Else er = False End If Next m Return End Sub |
|
Copyright ©2000 Moritoizumi all rights reserved.
|
