ます目計算か表計算ソフト

質問

全部で64ますに正負の数字が書いてあり、その中のますを縦横斜めにますを飛ばすことなく８個で連結した最大合計数の一番多い連結ますを探
せるソフトを御存知の方、教えてください。

回答No.4

judas_2006 · ベストアンサー

No.2&3です。急にアップグレード版を作ってみたくなり、挑戦してみました。今回のマクロは、ます目に数字を入力する方法として、手入力の他に、乱数を用いた自動入力も選択できるようになっています。また継続して使用することも考慮した形にしました。使い方は難しくないと思いますので、No.2ではなく、こちらを優先してお試し頂けないでしょうか。なお手入力の際もます目数を最初に指定する形式にしました。ます目数を変更する際は、一旦終了してから再度マクロを実行させて下さい。

Option Explicit
Sub ます目計算()

Dim Masu_Su_Max As Integer, Masu_Gokei_Max As Long, Masu_Gokei_Naname2 As Long
Dim Masu_Gokei_Yoko As Long, Masu_Gokei_Tate As Long, Masu_Gokei_Naname1 As Long
Dim Ichi_1 As Integer, Ichi_2 As Integer, Ichi_3 As Integer, Ichi_4 As Integer
Dim Ichi_Kekka_1 As Integer, Ichi_Kekka_2 As Integer, Tate_Offset As Integer, Yoko_Offset As Integer
Dim Kaishi As Integer, Shuryo As Integer, i As Integer, j As Integer, k As Integer
Dim Masu_Su As Integer, Ketasu As Integer, Saidai As Long, PlusMinus As Double
Dim Response As String, Nyuryoku As String, Fugo As String, Sujiretsu As String, Shusei As String
Dim Kari As Variant

Sheets("ます目計算").Select
Tate_Offset = 1 '0以上の整数
Yoko_Offset = 1 '0以上の整数
Masu_Su_Max = 102
Range(Cells(1, 1), Cells(Masu_Su_Max + Tate_Offset, Masu_Su_Max + Yoko_Offset)).Interior.ColorIndex = xlNone
Range(Cells(1, 1), Cells(Masu_Su_Max + Tate_Offset, Masu_Su_Max + Yoko_Offset)).ClearContents
Nyuryoku = MsgBox("自動入力なら「はい」、手入力なら「いいえ」をクリックして下さい。", vbYesNo, "入力モード指定")
Do
Let Masu_Su = InputBox("ます目数(2～100)を入力して下さい。　例：8×8 → 8", "ます目数指定")
If Masu_Su = Empty Then End
Loop While (Masu_Su < 2) Or (Masu_Su > 100)
Select Case Nyuryoku
Case vbYes
Nyuryoku = "自動入力"
Do
Let Ketasu = InputBox("最大桁数(1～6)を入力して下さい。", "桁数指定")
If Ketasu = Empty Then End
Loop While (Ketasu < 1) Or (Ketasu > 6)
Saidai = 10 ^ Ketasu - 1
Fugo = MsgBox("符号が正のみなら「はい」、正負なら「いいえ」をクリックして下さい。", vbYesNo, "符号指定")
Select Case Fugo
Case vbYes
Fugo = "正のみ"
Case vbNo
Fugo = "正負"
End Select

Case vbNo
Nyuryoku = "手入力"
End Select
Ichi_Kekka_1 = 1
Ichi_Kekka_2 = 2
Label1:
Cells(Ichi_Kekka_1 + Tate_Offset, Ichi_Kekka_2 + Yoko_Offset).Interior.ColorIndex = xlNone
Cells(Ichi_Kekka_1 + Tate_Offset, Ichi_Kekka_2 + Yoko_Offset).ClearContents
Range(Cells(1 + Tate_Offset, 1 + Yoko_Offset), Cells(Masu_Su + Tate_Offset, Masu_Su + Yoko_Offset)).Interior.ColorIndex = 36
Range(Cells(1 + Tate_Offset, 1 + Yoko_Offset), Cells(Masu_Su + Tate_Offset, Masu_Su + Yoko_Offset)).ClearContents
Cells(1 + Tate_Offset, 1 + Yoko_Offset).Select
Select Case Nyuryoku
Case "自動入力"
For i = 1 To Masu_Su
For j = 1 To Masu_Su
Select Case Fugo
Case "正のみ"
PlusMinus = 1
Case "正負"
PlusMinus = Rnd() - 0.5
If PlusMinus <> 0 Then
PlusMinus = PlusMinus / Abs(PlusMinus)
End If
End Select
Cells(i + Tate_Offset, j + Yoko_Offset) = PlusMinus * Round(Rnd() * Saidai, 0)
Next j
Next i
Case "手入力"
Kaishi = 1
Shuryo = Masu_Su
Do
For i = Kaishi To Shuryo
Do
Let Sujiretsu = InputBox(i & "行目の数字(" & Masu_Su & "個)をスペースで区切って入力して下さい。全て半角です。", "数字の入力")
If Sujiretsu = "" Then End
Kari = Split(Sujiretsu, " ")
Loop While (UBound(Kari) <> Masu_Su - 1)
For j = 1 To Masu_Su
Cells(i + Tate_Offset, j + Yoko_Offset) = Kari(j - 1)
Next j
Next i
Shusei = MsgBox("修正するときは「はい」、先に進むときは「いいえ」をクリックして下さい。", vbYesNo, "修正有無")
Select Case Shusei
Case vbYes
Shusei = "修正する"
Do
Let Kaishi = InputBox("何行目を修正しますか？", "修正箇所")
If Kaishi = Empty Then End
Loop While (Kaishi < 1) Or (Kaishi > Masu_Su)
Shuryo = Kaishi
Case vbNo
Shusei = "修正しない"
End Select
Loop While (Shusei = "修正する")
End Select
Response = MsgBox("正解を表示しても良ければ「OK」をクリックして下さい。", vbOKOnly, "正解表示")
Masu_Gokei_Max = 0
For i = 1 To Masu_Su
For j = 1 To Masu_Su
Masu_Gokei_Yoko = 0
Masu_Gokei_Tate = 0
For k = 1 To Masu_Su
Masu_Gokei_Yoko = Masu_Gokei_Yoko + Cells(j + Tate_Offset, k + Yoko_Offset)
Masu_Gokei_Tate = Masu_Gokei_Tate + Cells(k + Tate_Offset, j + Yoko_Offset)
Next k
If Masu_Gokei_Yoko > Masu_Gokei_Max Then
Ichi_1 = j
Ichi_2 = 1
Ichi_3 = j
Ichi_4 = Masu_Su
Masu_Gokei_Max = Masu_Gokei_Yoko
End If
If Masu_Gokei_Tate > Masu_Gokei_Max Then
Ichi_1 = 1
Ichi_2 = j
Ichi_3 = Masu_Su
Ichi_4 = j
Masu_Gokei_Max = Masu_Gokei_Tate
End If
Next j
Next i
For i = 1 To Masu_Su
Masu_Gokei_Naname1 = 0
Masu_Gokei_Naname2 = 0
For j = 1 To Masu_Su
Masu_Gokei_Naname1 = Masu_Gokei_Naname1 + Cells(j + Tate_Offset, j + Yoko_Offset)
Masu_Gokei_Naname2 = Masu_Gokei_Naname2 + Cells(Masu_Su - j + 1 + Tate_Offset, j + Yoko_Offset)
Next j
If Masu_Gokei_Naname1 > Masu_Gokei_Max Then
Ichi_1 = 1
Ichi_2 = 1
Ichi_3 = Masu_Su
Ichi_4 = Masu_Su
Masu_Gokei_Max = Masu_Gokei_Naname1
End If
If Masu_Gokei_Naname2 > Masu_Gokei_Max Then
Ichi_1 = Masu_Su
Ichi_2 = 1
Ichi_3 = 1
Ichi_4 = Masu_Su
Masu_Gokei_Max = Masu_Gokei_Naname2
End If
Next i
If (Ichi_1 = 1) And (Ichi_2 = 1) And (Ichi_3 = Masu_Su) And (Ichi_4 = Masu_Su) Then
For i = 1 To Masu_Su
Cells(i + Tate_Offset, i + Yoko_Offset).Interior.ColorIndex = 34
Next i
Ichi_Kekka_1 = Masu_Su + 1
Ichi_Kekka_2 = Masu_Su + 1
ElseIf (Ichi_1 = Masu_Su) And (Ichi_2 = 1) And (Ichi_3 = 1) And (Ichi_4 = Masu_Su) Then
For i = 1 To Masu_Su
Cells(Masu_Su - i + 1 + Tate_Offset, i + Yoko_Offset).Interior.ColorIndex = 34
Next i
If Yoko_Offset = 0 Then
Ichi_Kekka_1 = Masu_Su + 1
Ichi_Kekka_2 = 1
Else
Ichi_Kekka_1 = Masu_Su + 1
Ichi_Kekka_2 = Yoko_Offset - 1
End If
Else
Range(Cells(Ichi_1 + Tate_Offset, Ichi_2 + Yoko_Offset), Cells(Ichi_3 + Tate_Offset, Ichi_4 + Yoko_Offset)).Interior.ColorIndex = 34
If Ichi_1 = Ichi_3 Then
Ichi_Kekka_1 = Ichi_3
Ichi_Kekka_2 = Ichi_4 + 1
Else
Ichi_Kekka_1 = Ichi_3 + 1
Ichi_Kekka_2 = Ichi_4
End If
End If
Cells(Ichi_Kekka_1 + Tate_Offset, Ichi_Kekka_2 + Yoko_Offset).Interior.ColorIndex = 8
Cells(Ichi_Kekka_1 + Tate_Offset, Ichi_Kekka_2 + Yoko_Offset) = Masu_Gokei_Max
Cells(Ichi_Kekka_1 + Tate_Offset, Ichi_Kekka_2 + Yoko_Offset).Select
Response = MsgBox("ます目計算を続行しますか？", vbYesNo, "続行/終了")
If Response = vbYes Then GoTo Label1

End Sub

お礼

大変参考になりました。ありがとうございました。

補足

ご回答ありがとうございます。
エクセルでコピペして試してみました。
sheets("ます目計算").selectの箇所がインデックスが有効範囲にありません。とのエラーメッセージが出ましたのでその部分を削除して実行いたしました。自動入力及び手入力と両機能兼ね備えたすばらしいPROGで瞬時に最大値も出力でき、とても役にたちそうです。ありがとうございます。又、下記のようなプログラムはエクセルでつくるのは難しいのでしょうか?
参考までに教えてください。
(例)
－5 －(10) ＋(8) －7 ＋3
＋4 ＋6 －9 ＋(8) －5
－3 －9 ＋2 －7 ＋(6)
＋1 ＋4 ＋(9) ＋(10) －8
－7 ＋6 －3 ＋1 ＋6
合計51

全体のます目の中で起点となる数字を探す。
起点となる数字の負は、正に置き換える。
起点とするます目数字の上下左右斜め上下のます目数字を計算しながら
6つのます目で合計が最も大きいます目ルートを探し出し合計値を出す。この際、ます目を飛ばさない。交差させない。必ず隣り合わせのます目数字であること。
上記例では起点が －10で一番合計が大きくなる隣り合わせの6つのます目ルートを出したものです。

回答No.3

judas_2006

No.2です。
回答に示したマクロにあるメッセージボックス表示の日本が変でした(マクロではなくコメント文中にも漢字変換ミス等ありますが、そちらはご愛嬌ということでお願いします)。お手数をお掛けしますが、Excelに貼り付ける際、修正に願います。

（マクロの一番下の方です）
誤：Response = MsgBox("結果をクリアにてもいいですか", vbYesNo)
正：Response = MsgBox("結果をクリアしてもいいですか？", vbYesNo)

よろしくお願い致します。

回答No.2

judas_2006

No.1さんのご回答で99%OKと思います。
ただcrosさんのご質問を拝見したとき、これはマクロ初心者の私にはうってつけの演習問題と思ったものですから、Excel用マクロを作ってみました。非常に簡単なものなのでご満足頂けないかと思いますが、お試し頂けないでしょうか。

【使い方】
・1ます目(一番左の一番上)の位置は自由に選べます。変更したい場合は、Tate_Offset、Yoko_Offsetに0以上の整数を入れて下さい。現在はB2(Tate_Offset=1、Yoko_Offset=1)になっています。
・ます目数は、ます目の一番上の行に連続して入っているセル数をカウントして設定されます。最大数は安全のため100×100に制限してあります。
・現在使用中のシートで実行されます。特定のシートに限定したい場合は「' Sheets("ます目計算").Select」の先頭の「'」を削除し、"　"にシート名を入れて下さい。

【マクロ内容】
（マクロの貼り付けの歳、字下げのスペースが削除されてしまいました。また_による改行もしていません。大変見にくい申し訳ありませんが、ご容赦頂ければ幸いです）

Option Explicit
Sub ます目計算()

Dim Masu_Su_Max As Integer, Masu_Su As Integer, Masu_Gokei_Max As Integer, Masu_Gokei_Naname2 As Integer
Dim Masu_Gokei_Yoko As Integer, Masu_Gokei_Tate As Integer, Masu_Gokei_Naname1 As Integer
Dim Ichi_1 As Integer, Ichi_2 As Integer, Ichi_3 As Integer, Ichi_4 As Integer
Dim Ichi_Kekka_1 As Integer, Ichi_Kekka_2 As Integer, Tate_Offset As Integer, Yoko_Offset As Integer
Dim Kari As Integer, i As Integer, j As Integer, k As Integer
Dim Response As String

' Sheets("ます目計算").Select
Tate_Offset = 1
Yoko_Offset = 1
Masu_Su_Max = 100
Masu_Su = 1
Kari = -999
Do While (Kari <> Empty) And (Masu_Su <= Masu_Su_Max)
Kari = Cells(1 + Tate_Offset, Masu_Su + Yoko_Offset)
Masu_Su = Masu_Su + 1
Loop
Masu_Su = Masu_Su - 2
Range(Cells(1 + Tate_Offset, 1 + Yoko_Offset), Cells(Masu_Su + Tate_Offset, Masu_Su + Yoko_Offset)).Interior.ColorIndex = 36
Masu_Gokei_Max = 0
For i = 1 To Masu_Su
For j = 1 To Masu_Su
Masu_Gokei_Yoko = 0
Masu_Gokei_Tate = 0
For k = 1 To Masu_Su
Masu_Gokei_Yoko = Masu_Gokei_Yoko + Cells(j + Tate_Offset, k + Yoko_Offset)
Masu_Gokei_Tate = Masu_Gokei_Tate + Cells(k + Tate_Offset, j + Yoko_Offset)
Next k
If Masu_Gokei_Yoko > Masu_Gokei_Max Then
Ichi_1 = j
Ichi_2 = 1
Ichi_3 = j
Ichi_4 = Masu_Su
Masu_Gokei_Max = Masu_Gokei_Yoko
End If
If Masu_Gokei_Tate > Masu_Gokei_Max Then
Ichi_1 = 1
Ichi_2 = j
Ichi_3 = Masu_Su
Ichi_4 = j
Masu_Gokei_Max = Masu_Gokei_Tate
End If
Next j
Next i
For i = 1 To Masu_Su
Masu_Gokei_Naname1 = 0
Masu_Gokei_Naname2 = 0
For j = 1 To Masu_Su
Masu_Gokei_Naname1 = Masu_Gokei_Naname1 + Cells(j + Tate_Offset, j + Yoko_Offset)
Masu_Gokei_Naname2 = Masu_Gokei_Naname2 + Cells(Masu_Su - j + 1 + Tate_Offset, j + Yoko_Offset)
Next j
If Masu_Gokei_Naname1 > Masu_Gokei_Max Then
Ichi_1 = 1
Ichi_2 = 1
Ichi_3 = Masu_Su
Ichi_4 = Masu_Su
Masu_Gokei_Max = Masu_Gokei_Naname1
End If
If Masu_Gokei_Naname2 > Masu_Gokei_Max Then
Ichi_1 = Masu_Su
Ichi_2 = 1
Ichi_3 = 1
Ichi_4 = Masu_Su
Masu_Gokei_Max = Masu_Gokei_Naname2
End If
Next i
If (Ichi_1 = 1) And (Ichi_2 = 1) And (Ichi_3 = Masu_Su) And (Ichi_4 = Masu_Su) Then
For i = 1 To Masu_Su
Cells(i + Tate_Offset, i + Yoko_Offset).Interior.ColorIndex = 34
Next i
Ichi_Kekka_1 = Masu_Su + 1
Ichi_Kekka_2 = Masu_Su + 1
ElseIf (Ichi_1 = Masu_Su) And (Ichi_2 = 1) And (Ichi_3 = 1) And (Ichi_4 = Masu_Su) Then
For i = 1 To Masu_Su
Cells(Masu_Su - i + 1 + Tate_Offset, i + Yoko_Offset).Interior.ColorIndex = 34
Next i
If Yoko_Offset = 0 Then
Ichi_Kekka_1 = Masu_Su + 1
Ichi_Kekka_2 = 1
Else
Ichi_Kekka_1 = Masu_Su + 1
Ichi_Kekka_2 = Yoko_Offset - 1
End If
Else
Range(Cells(Ichi_1 + Tate_Offset, Ichi_2 + Yoko_Offset), Cells(Ichi_3 + Tate_Offset, Ichi_4 + Yoko_Offset)).Interior.ColorIndex = 34
If Ichi_1 = Ichi_3 Then
Ichi_Kekka_1 = Ichi_3
Ichi_Kekka_2 = Ichi_4 + 1
Else
Ichi_Kekka_1 = Ichi_3 + 1
Ichi_Kekka_2 = Ichi_4
End If
End If
Cells(Ichi_Kekka_1 + Tate_Offset, Ichi_Kekka_2 + Yoko_Offset).Interior.ColorIndex = 8
Cells(Ichi_Kekka_1 + Tate_Offset, Ichi_Kekka_2 + Yoko_Offset) = Masu_Gokei_Max
Response = MsgBox("結果をクリアにてもいいですか", vbYesNo)
If Response = vbYes Then
Range(Cells(1 + Tate_Offset, 1 + Yoko_Offset), Cells(Masu_Su + Tate_Offset, Masu_Su + Yoko_Offset)).Interior.ColorIndex = xlNone
Range(Cells(1 + Tate_Offset, 1 + Yoko_Offset), Cells(Masu_Su + Tate_Offset, Masu_Su + Yoko_Offset)).Interior.ColorIndex = 36
Cells(Ichi_Kekka_1 + Tate_Offset, Ichi_Kekka_2 + Yoko_Offset).Interior.ColorIndex = xlNone
Cells(Ichi_Kekka_1 + Tate_Offset, Ichi_Kekka_2 + Yoko_Offset).ClearContents
End If
Cells(Ichi_Kekka_1 + Tate_Offset, Ichi_Kekka_2 + Yoko_Offset).Select

End Sub

（注）
マクロを全くご存じなければ、以下の操作をしてみて下さい。
「ツール」「マクロ」「マクロ」を選択し、マクロ名のところに、(例えば)"ます目計算"を入力して下さい。次に「作成」をクリックすると、下のような画面が出てくると思いますので、上記のように修正して下さい。作業が完了したら、「デバッグ」「VBAProjectのコンパイル」を選択して下さい。ここでもしエラーが出てしまったら、近くの詳しい方に教えて頂くのが賢明です。無事コンパイルが終了したら、(このままでも動くのですが)「ファイル」「終了してMicrosoft PowerPointへ戻る」を選択して下さい。実行は「ツール」「マクロ」「マクロ」で実行するマクロ名を選択し「実行」をクリックして下さい(シート上にボタンを作成しクリックすれば実行できるようになるのですが、説明がやや複雑になるので今回は省略します)。なおファイルを保存後に再度開く際は「マクロを有効にする」をクリックして下さい。何も表示が出ず、ファイルが開いてしまう等の場合は、「ツール」「オプション」タブ「セキュリティ」タブ「セキュリティレベル」で「中」を選択して下さい。

Option Explicit

Sub ます目計算()
'
' マクロ作成日 : 2006/11/13 作成者 : ●●
'

End Sub

回答No.1

bell_xxx

Excelでは駄目でしょうか？

B1セルからI8までに数値を入れ、下記のセルのように式を入れればそれぞれの合計が出ます。

J1=SUM(B1:I1)
J2=SUM(B2:I2)
J3=SUM(B3:I3)
J4=SUM(B4:I4)
J5=SUM(B5:I5)
J6=SUM(B6:I6)
J7=SUM(B7:I7)
J8=SUM(B8:I8)

A9==B8+C7+D6+E5+F4+G3+H2+I1
B9=SUM(B1:B8)
C9=SUM(C1:C8)
D9=SUM(D1:D8)
E9=SUM(E1:E8)
F9=SUM(F1:F8)
G9=SUM(G1:G8)
H9=SUM(H1:H8)
I9=SUM(I1:I8)
J9==B1+C2+D3+E4+F5+G6+H7+I8

あとは見れば最大が判ると思いますが、式でやるなら
=MAX(J1:J9,A9:I9)
をどこかのセルに入れれば最大値が判ると思います。

お礼

ご回答ありがとうございます。
エクセルを使うことは全然考えていませんでした。
大変参考になりました。