第178回 最後に勝ち残るのは？

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　(ジョー３さん）

解答用参考ファイル： Q178をダウンロード

**********************************************************************************

尚、解答締め切りは０９／２９（日）の午後８時の予定です。状況によっては

変更される可能性があります。

また、解答発表までは直接数式を書き込むこと・ポイントとなる関数名を

書き込むことはご遠慮ください。

********************************************************************************

Comments

[投稿情報: y sakuda]

ありや、もう出てる。
結構難しいぞ・・・・・

[投稿情報: ｼﾞｮｰ3]

>ありや、もう出てる。
ホントだ、、はえーーーーー
ってことは、、、意味が通ったのね・・・・よかったーーーー

＞結構難しいぞ・・・・・
ん、、、黄色ですか??
＝ようやくやったけど、,,

青ですか??
まだやってないのよねーーーー私は、、、

[投稿情報: y sakuda]

もちろん、黄色です。
所で、範囲外になる後ろの方は放置で良いですか？
今のところそれ放置しても100をちょっと超す^^;

[投稿情報: ｼﾞｮｰ3]

>所で、範囲外になる後ろの方は放置で良いですか？
B17まで式をコピーしてあれば、、
それ以降はあり得ない、、C2,C3ですから、、、B18以降は放置で良いです。

＞今のところそれ放置しても100をちょっと超す^^;
はえーーーー・・・・・、、、
まあ、ちょっとは、、、短いけど、、、時間の問題かも、,,

で、こんな問題・・・・やったこと無かったですか??数学??

[投稿情報: ｼﾞｮｰ3]

で、今回も、、、みなさん、、、気付いてないかなーーー
・・・・・・・・＆くまぷーさんは、、、秒殺の・・・知識だったり・・・

[投稿情報: kumapooh]

＞・・・・・・・・＆くまぷーさんは、、、秒殺の・・・知識だったり・・・

今日も部活指導と会議で遅くなり
まず、問題をアップした後食事を終えて
今、風呂から上がったところです。
解答は明日考えます。

＞ってことは、、、意味が通ったのね・・・・よかったーーーー

意味はすぐにわかりました。
今回は、図に力を入れていますね～

[投稿情報: ｼﾞｮｰ3]

>意味はすぐにわかりました。
あーーよかった。
＞今回は、図に力を入れていますね～
そりゃ、、、わかりにくいって言われなかったこと無いから・・・
・・・・・・反省の図でしょ、、、

[投稿情報: ｼﾞｮｰ3]

ってことで、おらも風呂入ってねる。

[投稿情報: y sakuda]

いえ、範囲外ってのは、例えば2ケタなら2マスで終わるからそれ以降にエラーが出ても良いか？と言う意味です。
どうにでもなるわけですが、長さの比較がわけ分からなくなりますから・・・

>こんな問題・・・・やったこと無かったですか??数学??
やったことないです。
直感的には簡単な計算で出そうですけど、まだそこまで行ってません。

[投稿情報: y sakuda]

とりあえず、黄色は99。
あってるかどうかの検証やって、それから青を考えます。

[投稿情報: y sakuda]

検証と言うほどのことをやらずに間違え発見。
こりゃむずかしいや^^;

[投稿情報: ｼﾞｮｰ3]

>いえ、範囲外ってのは、例えば2ケタなら2マスで終わるから
>それ以降にエラーが出ても良いか？と言う意味です。
>どうにでもなるわけですが、長さの比較がわけ分からなくなりますから・・・

では、エラー処理して、、、数えて・・・
二桁です。・・・

[投稿情報: ｼﾞｮｰ3]

あ、、、、
青い方は・・・・やれる気がしない。

一応、最大１３人だから（１３文字）・・・
何とかする方おられる・・・とは、、思えるがね、、

最大４０文字なんてことにしたら・・・やる気にならない（自分）
まあ、、、もしかして、、、黄色を簡単に解く方が、、おられたら、
青に取り組みたい・・・・かなーーー私も、、、もしかして・・・レベルだけど。

[投稿情報: min]

黄色なら、簡単だと思いますが。
青は、どうなんでしょう？

[投稿情報: ｼﾞｮｰ3]

>黄色なら、簡単だと思いますが。
おおーーー私は苦労したぞ、、、
＞青は、どうなんでしょう？
わたしは、やれそうにないぞ、、
期待しております。

[投稿情報: y sakuda]

やっと86

[投稿情報: ｼﾞｮｰ3]

>やっと86
おおーーーーやるもんだね、、
他の方は、どうでしょうねーーー
色々な手がありそうで、、どなたの工夫が・・・面白いか、、
楽しみですーーーー

[投稿情報: y sakuda]

一応、答えの漸化式は読めたつもりですが、繰り返し計算を避ける手段まで思いつけない。
何とかならんかな？

[投稿情報: y sakuda]

例によって、チェッカー出しときます。
標準モジュールに↓を張り付けて、空いているセルに　=Check()と入れてください。
黄色のシークェンスが正しければ、Trueと表示されます。

Function Check()
Dim wData As String, wLen As Long, wRes As Long
Dim I As Long, J As Long, K As Long
Dim wAns As String, wBAns As String
Dim wFlg As Boolean
Application.Volatile
With ActiveSheet
wData = .Range("B5")
wLen = .Range("C2")
wRes = .Range("C3")
wBAns = wData
wFlg = True
For I = wLen To 2 Step -1
J = 0

For K = 1 To wRes
J = J + 1
If J > I Then
J = 1
End If
Next
If J > 1 Then
wAns = Left(wBAns, J - 1)
Else
wAns = ""
End If
If J .Range("B5").Offset(wLen - I + 1, 0).Value Then
wFlg = False
Exit For
End If
wBAns = wAns
Next
Check = wFlg
End With
End Function

[投稿情報: ｼﾞｮｰ3]

>例によって、チェッカー出しときます。
ありがとうございます。
理屈的に自信があるので・・・まだ、使わないで置きます。
で、黄色は、、やりましたが、、アイデアもちょっと気に入ってます。

青は、まだ、、時間も気力もありません。

黄色の数字は、あと、２，３名の書き込みがあれば・・・書きますけど、、
２人で出し合ってもねーーー・・・と、おもってっます。
まあ、、１０の位＋１の位ぐらいは、、出しても良いかなーー

１３ぐらいだと、思いました。でも、、、色々あるよねーーーって、ことで、

[投稿情報: ｼﾞｮｰ3]

あと、、、
うちのエクセル好きの社員にも、出題しました。２人／３人
まだ出来ていない、、、・・・・・・・
って、ことは、、、適度に良い問題らしい。

[投稿情報: ｼﾞｮｰ3]

>まだ出来ていない、、、・・・・・・・
と、言ったとたんに、、、社員の一人から出来た！！と、報告
ほほーーーー
sakudaさんチェックで、、、チェックしたら、、、書き込んでもらいましょうね、，

[投稿情報: y sakuda]

そうですねーー
誰も出てきませんね^^;

[投稿情報: min]

sakudaさんのチェック
If J .Range("B5").Offset(wLen - I + 1, 0).Value Then
がエラーになりますがどうなんでしょ。
VBAさっぱりなんでよくわかりません。

もしかして
If J = .Range("B5").Offset(wLen - I + 1, 0).Value Then
でしょうか？

[投稿情報: min]

一応
＞If J = .Range("B5").Offset(wLen - I + 1, 0).Value Then
に書き換えても計算結果はfalseが出ますが。

[投稿情報: ｼﾞｮｰ3]

ほほーーーー
で、、、

minmaxさん、、、何文字ぐらいですか?

しりたいなーーーー、、、、、
ってことで、、、

[投稿情報: min]

チェックぴログラムが動かないし、
チェックプログラムを少々変更しても、falseがでますので
保証が全くありませんが、50以下です。
ジョー3さんさんも同じくらいでしょ。

[投稿情報: kumapooh]

＞もしかして
＞If J = .Range("B5").Offset(wLen - I + 1, 0).Value Then
＞でしょうか？

If J = Range("B5").Offset(wLen - I + 1, 0).Value Then

でないだろうか？
sakudaさんがでてこないので・・・

あ、ActiveSheetのWithブロックの中だから
同じか・・・

[投稿情報: ｼﾞｮｰ3]

>保証が全くありませんが、50以下です。
>ジョー3さんさんも同じくらいでしょ
げげーーーー、、、見てみました。。
おおーーーー４７でした。
あたりーーー・・・・・

ん、、、
読まれてたね、、

あ、、、
１０代＋１代・・・・１１か？？

[投稿情報: ｼﾞｮｰ3]

なんか、、、短いのは、、、
４７だが、、、

minmaxさんには、、、
かなうわけがなかった。
ってことで、、、

ちょっと、のんだしね、、、

[投稿情報: からくち]

問題、、、見ました

＜黄＞、、、秒殺とは、、、何秒までかな
KEYを打つのが１文字１秒として３６秒で出来た

＜青＞、、、これは面白そうですね、、、黄ｘ２～1.5以下で出来ないものか
考え方が色々、、、実に楽しそう、、、遊びたいです

[投稿情報: y sakuda]

>If J .Range("B5").Offset(wLen - I + 1, 0).Value Then
済みません。
貼り付けてからコメント消した時ミスったようです。

If .Range("B5").Offset(wLen - I + 1, 0).Value Then
です。
Falseが出るんですか？
　　MsgBox wAns
If wAns <> .Range("B5").Offset(wLen - I + 1, 0).Value Then
wFlg = False
Exit For
End If
Msgboxを一行入れて見てください。
しかし、これ、セルの値が変わるたびにひつこくでますので、ご注意ください。

[投稿情報: y sakuda]

50以下？
まるで思いつかないですねーー
ずっと青の方に頭がいってますが、うまい手が出てこない。

[投稿情報: y sakuda]

Checkerについての追記
シート式の結果の後ろの方に隠れたブランクなんかがあると不一致扱いになります。
特に意識してTrimなんかいれてませんので。

[投稿情報: min]

からくちさんが３６ですか。
１文字合わない。何が違うのかな。

sakudaさんへ
コードを再度全部貼り付けてもらえませんか。
当初の
If J .Range("B5").Offset(wLen - I + 1, 0).Value Then
を
If .Range("B5").Offset(wLen - I + 1, 0).Value Then
に修正してもうまくいかないような感じです。

[投稿情報: y sakuda]

>コードを再度全部貼り付けてもらえませんか。
済みません。よく見たらひどい削りミスやってましたので、全部再掲します。

Function Check()
Dim wData As String, wLen As Long, wRes As Long
Dim I As Long, J As Long, K As Long
Dim wAns As String, wBAns As String
Dim wFlg As Boolean
Application.Volatile
With ActiveSheet
wData = .Range("B5")
wLen = .Range("C2")
wRes = .Range("C3")
wBAns = wData
wFlg = True
For I = wLen To 2 Step -1
J = 0
For K = 1 To wRes
J = J + 1
If J > I Then
J = 1
End If
Next
If J > 1 Then
wAns = Left(wBAns, J - 1)
Else
wAns = ""
End If
If J .Range("B5").Offset(wLen - I + 1, 0).Value Then
wFlg = False
Exit For
End If
wBAns = wAns
Next
Check = wFlg
End With
End Function

[投稿情報: y sakuda]

再再掲です。
例の不等号で切れる症状がややこしく絡んでます。
Function Check()
Dim wData As String, wLen As Long, wRes As Long
Dim I As Long, J As Long, K As Long
Dim wAns As String, wBAns As String
Dim wFlg As Boolean
Application.Volatile
With ActiveSheet
wData = .Range("B5")
wLen = .Range("C2")
wRes = .Range("C3")
wBAns = wData
wFlg = True
For I = wLen To 2 Step -1
J = 0
For K = 1 To wRes
J = J + 1
If J ＞ I Then
J = 1
End If
Next
If J ＞ 1 Then
wAns = Left(wBAns, J - 1)
Else
wAns = ""
End If
If J ＜ I Then
wAns = Mid(wBAns, J + 1, 13) & wAns
End If
If wAns ＜＞ .Range("B5").Offset(wLen - I + 1, 0).Value Then
wFlg = False
Exit For
End If
wBAns = wAns
Next
Check = wFlg
End With
End Function

[投稿情報: y sakuda]

36？？
ちょっと短くなったけど、ダブルスコアだな・・・・

[投稿情報: min]

＞再再掲です。
ありがとうございました。

[投稿情報: y sakuda]

例によって、難かしく考えすぎてた・・・・
大幅減で39。
36ってのはなんだろ？後はエラー処理のところくらいしか削りどころがなさそうだけど、これあまり減りそうに見えないし・・・・

[投稿情報: ｼﾞｮｰ3]

からくちさん、、参りました。
言われて、短縮がんばって、、ようやく・・３６出来ました。
最初から、すぐ、、無駄を省いた式出来るって、凄いですね。

で、、

minmaxさんは、、もしかして３５？

[投稿情報: ｼﾞｮｰ3]

３５もわかった。・・・・だが、、、
３６も
３５も
最初に言い出した方が、、、凄いのだ、、、
・・・・・・・・・・・・・

で、、青は、、、、

[投稿情報: y sakuda]

青は研究してますが、循環参照でも使わない限りダメっぽく思えてきました。

[投稿情報: kumapooh]

何か、法則があると思うのですが
うまくいきません　(T.T)

[投稿情報: ｼﾞｮｰ3]

私も、名案無し、・・・・・・どなたが、、、、・・・・・

[投稿情報: ｼﾞｮｰ3]

うまくいきそうにないので、遊んでみた・・・この条件で、、
１からDのどれが残る確率が多いのだろうと・・・・・

[投稿情報: y sakuda]

>何か、法則があると思うのですが
法則はみつけたのですが、繰り返し計算が必要な代物なので、ワンセルには書けない。

[投稿情報: ｼﾞｮｰ3]

青：短いのは思いつきません。
仕方ないから、、長いの作ろうかなーーー、、
仕事から帰って、、夕方、・・・・・・
４００文字～５００文字の予感だが、、

[投稿情報: y sakuda]

長さの前にネスティングレベルが・・・・
2007以降じゃないとダメかもです。

私の考えた手法では単純な力技よりスマートですが、8からではなく、1からやる必要があるので13レベル必要になっちゃうので、2003では初めから無理

[投稿情報: ｼﾞｮｰ3]

>長さの前にネスティングレベルが・・・・
>2007以降じゃないとダメかもです。
そうでしたそうでした。
今お昼途中まで書いたら、、、叱られました。

[投稿情報: y sakuda]

2013で青やって見ました。
前に書いたように繰り返しが必要なものなので、ひたすら長くなるわけですが、以外と短くなり、295でした。
まあ、ネストは13になるのか、14になるのか良くわかりませんが、とにかく2003では無理。
多少はもう少しなんとかなるのかもしれませんが、ダイエット作業やる気にならないｗ

[投稿情報: y sakuda]

ちょっと疲れましたが、ちゃんと動いたので達成感ありです^^

[投稿情報: kumapooh]

>ちょっと疲れましたが、ちゃんと動いたので達成感ありです^^

すごい！！
私はその前の段階、法則を見つけるところで止まっています。
この頃、根気が続きません・・・(T_T)

[投稿情報: ｼﾞｮｰ3]

>2013で青やって見ました。
>295でした。
おお、、、では私も、、、２００７で、、、続きを・・・・・
単純繰り返し、なので、、疲れないが・・・
３５２文字でした。

[投稿情報: ｼﾞｮｰ3]

出かける前に、、
無駄だらけではあるが、、
出題時回答例を送っておきます（黄色）

[投稿情報: kumapooh]

ただいま体育館から戻ってきましたら
ジョー３さんから出題者回答案が届いていました。
ありがとうございます。
８時に公開させていただきます。

せっかく出題していただいたのに
今回は何もできませんでした。
申し訳ありません。