エクセルのVBAでの7×7の魔方陣とは

このQ&Aのポイント
  • 講義の宿題で7×7の魔方陣をVBAで解く方法を教えてください。
  • 自分のスキルでは解けないため、詳しい手順が知りたいです。
  • 数値の書き出し順番や枠をはみ出した場合の処理についても教えてください。
回答を見る
  • ベストアンサー

エクセルのVBAでの7×7の魔方陣とは……

講義の宿題で7×7の魔方陣をVBAで解いてこいといわれました。 しかしながら自分のスキルではどうにもなりませんでした。 自分はIFやDim等までしか習っていません。 課題の注意点としては 1から49までの数値を検出 「1」は1行目の中央(4列目)に書き出す 基本的に、数値の書き出す順番は斜め上に移動 また、書き込む数値を「7」で割った場合の余りが「1」の時 書き込みの場所は下方向に移動する。 枠をはみ出した場合   上にはみ出した(行)の場合  7行目に   右にはみ出した(列)の場合  1列目に  それぞれ移動 以上のような条件でエクセルのVBEを用いて解きたいのですが、どうにも分かりません。自分でも様々なサイトで調べてみたところどれも難しすぎて理解できませんでした。 心優しき方は教えていただけると幸いです。 よろしくお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • KG_
  • ベストアンサー率62% (34/54)
回答No.1

整数の2次元配列を魔方陣に見立ててやってみました。 ただ、ご提示の条件では書ききれなかったのと勝手に判断した部分がありますので、ご参考程度にしていただければと思います。 こちらで勝手に判断した、勝手に解釈した点は以下の通りです。 ・「斜め上に移動」は「右斜め上に移動」と解釈 ・「下にはみ出した(行)の場合 1行目に」 基本的に右に進んでるだけですので、左にはみ出した場合は想定してません。 以下、サンプルです。出力方法は指定がなかったので最終的に配列の1,1から7,7まで取り出して頂ければと思います。   Dim MAHOUJIN(1 To 7, 1 To 7) As Integer   Dim i As Integer   Dim x As Integer   Dim y As Integer      x = 1   y = 4      MAHOUJIN(x, y) = 1      For i = 2 To 49     If i Mod 7 = 1 Then       y = y + 1     Else       x = x + 1       y = y - 1     End If     If x > 7 Then       x = 1     End If     If y > 7 Then       y = 1     End If     If y < 1 Then       y = 7     End If     MAHOUJIN(x, y) = i   Next

ACETON
質問者

お礼

ありがとうございます!! この意見を参考にして解いてみたいと思います!!

その他の回答 (4)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.5

http://www.ne.jp/asahi/suzuki/hp/houjin51.htm に載っている5の場合を参考に 奇方陣の作り方 右上に進む、が基本で 下記4つのIF文がルールのようだ。 ーー コード 標準モジュールに Sub test01() n = 7 x = 1: y = Int((n + 1) / 2) For i = 1 To n * n Cells(x, y) = i MsgBox i x = x - 1: y = y + 1 If x < 1 And y > n Then x = x + 2: y = y - 1 End If If x < 1 Then x = x + n If y > n Then y = y - n If Cells(x, y) <> "" Then x = x + 2: y = y - 1 End If Next i End Sub ーーーーー 30 39 48 1 10 19 28 38 47 7 9 18 27 29 46 6 8 17 26 35 37 5 14 16 25 34 36 45 13 15 24 33 42 44 4 21 23 32 41 43 3 12 22 31 40 49 2 11 20 5,7で確認済み。 ーー この質問のコーナーの規約では、宿題の問題は質問に出してならないはず。

  • end-u
  • ベストアンサー率79% (496/625)
回答No.4

『宿題』は自分で取り組まないと意味がないのではないですか? 今回のケースはきっと結果の表があって、 結果から法則を見つけて、その解法のためにどんなコーディングをすれば良いか、 というスキルを身に付けようとするものではないでしょうか。 役割を考えて変数を使う事、 Mod関数について知る事、 数値を入れるアドレスをどうやって導き出すか考える事、などがポイントになりそう。 ...なので、いきなりコードを書くのではなくて、 紙の上でいろいろ悩んでみる事が必要じゃないですか? 一例ですが、 Sub try()   Const n As Long = 7   Dim v(1 To n, 1 To n) As Long   Dim w As Long   Dim x As Long   Dim y As Long   Dim i As Long   Dim j As Long   w = 0   For i = 1 To n     For j = 1 To n       x = (j + i * (n - 1) + n \ 2) Mod n + 1       y = (j + i * (n - 2)) Mod n + 1       w = w + 1       v(y, x) = w     Next   Next   Range("A1").Resize(n, n).Value = v End Sub あえて >基本的に、数値の書き出す順番は斜め上に移動 これを無視しました。 何かのヒントになれば幸いです。 #まぁ、数値の増減方向が違うのは考えるのが面倒くさい、というのがホンネだったんですが、 #書いてみて、あと6文字程度追加すればいいだけなのに気付いたり...

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.3

>講義の宿題で7×7の魔方陣をVBAで解いてこいといわれました。 >しかしながら自分のスキルではどうにもなりませんでした。 >自分はIFやDim等までしか習っていません。 少なくとも教えられた範囲で解答できる宿題を出されていると思います。 或いは受けていない講義があるのでは? その場合には受けた人に教わるのも手ですけれど。

  • keirika
  • ベストアンサー率42% (279/658)
回答No.2

Sub Sample() Dim i As Integer Dim x As Integer Dim y As Integer Dim x1 As Integer Dim y1 As Integer x = 4 y = 1 Cells(y, x) = 1 For i = 2 To 49 If i Mod 7 = 1 Then y = y + 1 If y = 8 Then y = 1 End If Cells(y, x) = i Else x1 = x + 1 y1 = y - 1 If x1 = 8 Then x1 = 1 End If If y1 = 0 Then y1 = 7 End If If Cells(y1, x1) = "" Then Cells(y1, x1) = i y = y1 x = x1 Else x1 = x - 1 If x1 = 0 Then x1 = 7 End If Cells(y1, x1) = i x = x1 y = y1 End If End If Next i End Sub

ACETON
質問者

お礼

大変参考になりました!! これを基に考えてみたいと思います!!

関連するQ&A

  • 5次の超魔方陣の問題

    五次の超魔方陣を左右に一度ずつコピーした数の列をさらに上下に一度ずつコピーしてできる、全体で225個からなる数の表をこしらえる。この数表から、連続した5行5列のマスを任意に切り出す。このとき、この5行5列のマスはやはり超魔方陣になっている。この理由が何でしょうか?五次に魔方陣はなんとか出来ました。  11 24 7 20 3  これをコピーして225個から数の表を作ったのですが、そこ 4 12 25 8 16  からよく分かりません。どうすれば説明できるでしょうか? 17 5 13 21 9  10 18 1 14 22  23 6 19 2 15

  • 配列を使って魔方陣

    C言語を使って最近やっと配列ができるようになってきたんですが、どうしても魔方陣のやり方がわからないんです。教えてください。 魔方陣とは、1~n^2までの整数をn×nの正方形に並べ、どの行、どの列、どの対角線のn個の数の和も一定の値になるようにしたものです。 nは常に奇数を入力し、1番上の行の中央の列に1を置く事になります。 整数kまで置かれているとすると、k+1は次のように置かれる。 * kの置かれた場所の右斜め上(以下この場所をαと呼ぶ)が空いていれば、そこにk+1を置く。 * αがすでに他の数が置かれているとき、kの置かれている場所のすぐ下にk+1を置く。 * αが右上隅にはみ出す場合は、kの置かれている場所のすぐ下にk+1を置く。 * αが1番上の行からはみ出す場合は、場所αの1番下の列にk+1を置く。 * αが1番右上の列からはみ出す場合には、場所αの1番左の列にk+1を置く。 例)n=3のとき 8 1 6 3 5 7 4 9 2 まだまだ初心者なので詳しく教えていただけると嬉しいです。よろしくお願いします。

  • 魔方陣のつくりかた

    JAVAを習い始めの初心者です。夏休みの宿題で「5×5の魔方陣を2次配列を使って作りましょう」という事なのですが、さっぱりです。問題は、 (1)全てのます目に0を代入し、0列の真中に1を入れる。 (2)最後に入れた位置の左斜め上の位置を候補位置とする。候補位置が欄外になる場合は、欄外にも魔方陣があるものと考え、対応する位置を候補位置とする。 (3)既に数字が設定されたいたら最後に入れた位置の右の位置に数字をいれる。 助けてください。よろしくお願いします。

  • ラテン方陣に関して

    1 2 3 4 5 2 3 4 5 1 3 4 5 1 2 4 5 1 2 3 5 1 2 3 4 のように、縦、横、同じ数が一度しか出でこない方陣を「ラテン方陣」と言うそうです。通常の「魔方陣」とは違って、「ラテン方陣」の場合、縦・横は絶対に合計が同じになりますが、対角の合計は同じでなくても、いいみたいです。 今、9 × 9 のラテン方陣が、全部で何通り、存在するのかや、それをコンピューターやソフトかなにかで、簡単に計算することができるのか、そういうことを頼める業者はないものなのかで、とても困っています。 9 × 9 のラテン方陣とは 1 2 3 4 5 6 7 8 9 2 3 4 5 6 7 8 9 1 3 4 5 6 7 8 9 1 2 4 5 6 7 8 9 1 2 3 5 6 7 8 9 1 2 3 4 6 7 8 9 1 2 3 4 5 7 8 9 1 2 3 4 5 6 8 9 1 2 3 4 5 6 7 9 1 2 3 4 5 6 7 8 ですが、この方陣の行と列をどのように入れ替えても、ラテン方陣、縦・横、同じ数字は一度しか出てこないラテン方陣ができ、その数は、きっと、ものすごい数のパターンがあると思います。 順番が1 2 3 4 5 6 7 8 9 でなくても、 1 3 5 7 9 2 4 6 8 3 5 7 9 2 4 6 8 1 5 7 9 2 4 6 8 1 3 7 9 2 4 6 8 1 3 5 9 2 4 6 8 1 3 5 7 2 4 6 8 1 3 5 7 9 4 6 8 1 3 5 7 9 2 6 8 1 3 5 7 9 2 4 8 1 3 5 7 9 2 4 6 のようなものもあります。 このようなラテン方陣を作成できるソフトや、何通りあるのかを調べるには、一体、どうしたらいいのでしょうか。 最後にもう一つだけお願いしたいのですが、とりあえずのところ、1 2 3 4 5 6 7 8 9という9個の数字の並べ方が、何通りあるのか、どなたか教えて下さい。 9の ! (階乗)で計算するのでしょうか?

  • 5×6の魔方陣について

    弟の冬休みの宿題の中に紛れ込んでいた問題について、分からなかったので兄の威信のためにご協力ください。 問題をテキストの通り載せます。 問  2 3 6 7 9 だけを使い、縦、横、ななめの合計が全て27になるように、下の魔方陣を完成させてください。 添付データのようにすでに5箇所に数字が書き込まれています。問題文の説明が正直分かりにくいのですが、縦が六マスあるので、数字は指定されているものならば何度も使用できると考えられます。 ただ、「ななめ」にかんしては、意味が分からなかったので5マス数えられる4箇所を27にすればいいのではないかと考えています。4マスや3マスでも27に出来ますが、間違いなく矛盾が起こってしまい崩壊してしまいますので無視することにしました。……恐らくですが。 エクセルで色々いじってみたのですが、分からなくなってしまいました。 ななめの意味が分からない、無理だ、と言う場合、よろしければ縦と横だけでも結構ですのでご協力おねがいします。

  • エクセルVBA

    A列を基準にBC列が空白ならAの数値を入れて、A>BならB列を更新、A<CならC列を更新 A列が数値以外ならその行をスキップ、という処理をしたいのですが Option Explicit Dim A As Range, B As Range, C As Range Dim i As Long Sub test() For i = 1 To 10 Set A = Cells(i, 1) Set B = A.Offset(0, 1) Set C = A.Offset(0, 2) If IsNumeric(A) Then Else Exit Sub End If If B.Value = "" Then B.Value = A.Value If C.Value = "" Then C.Value = A.Value If A.Value > B.Value Then B.Value = A.Value If A.Value < C.Value Then C.Value = A.Value Next i End Sub とすると数値以外の行の時点で停止してしまいます。 その行を飛ばして次の行に進むにはどうしたらいいのでしょうか?

  • Excel collectionについて VBA

    Dim Mydata As New Collection Dim i As Long Dim EndNumber As Long On Error Resume Next 'データを登録する間、エラーを無視する For i = 2 To EndNumber '2行目から最終行までチェック Mydata.Add Range("J" & i).Value, Range("J" & i).Value 'J列のデータ取得 Next i On Error GoTo 0 i = 1 For Each A In Mydata Worksheets("Sheet1").Range("A" & i).Value = A i = i + 1 Next A 現在見ているシートの重複しない項目を 別シートに書き込みしているプログラムになります。 様々なサイトを参考にさせて頂き、 上記のような結果になり、 文字列は取得できるようになりました。 しかし、もとになるデータがある位置に(例は、J列) 数値が入っていると上手くコレクションに入ってくれません。 J列に文字列(りんご、ごりらなど)が入っている場合は 重複しない項目がコレクションに格納されていきます。 J列に文字列(0,1)が入っていた場合、 重複しない項目もなにも無く、 ローカルのMydataの中には<変数無し>とありました。 このプログラムの何処を直せば、数値をコレクションとして取得できますか? ちなみに、EndNumberには最終行の数値が入っています。 >Mydata.Add Range("J" & i).Value, Range("J" & i).Value 'J列のデータ取得 .valueを.stringにしても効果はありませんでした。 回答よろしくお願いいたします。

  • エクセルVBAで教えて下さい。

    エクセルVBAで以下の方法のマクロが分からず、教えて頂きたいです。 まず、ブックAのシートAがあり、シートAのセルD3には号機No.を入力します(999などの数値のみ) 次にブックBのシートBがあり、このシートのD列にも号機No.が入力されています。 やりたい事はブックAのシートAのD3に号機No.を入力したら、ブックBのシートBのD列から同じ号機No.を 探し、当てはまる号機の行のI列、J列、K列、L列、M列をコピーし ブックAのシートAのF13、F14、F15、F16、F17、に貼り付けたいです。 それぞれの貼り付け先は K列⇒F13 L列⇒F14 M列⇒F15 I列⇒F16 J列⇒F17のようになります。 それとブックBのシートBのD列に入力されている号機No.は同じ数値が入力されている時があります。 この場合は必ず下にある号機No.のが最新ですので、そちらを読み取るようにしたいです。 例えば、4行目と8行目に同じ号機No.がある場合は8行目の方を読み取る。 現在は GYOU = Application.InputBox でターゲットの行番号を入力して その行の列をコピー・ペーストしている感じです。 Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim tmp() As String If Intersect(Target, Range("D3")) Is Nothing Then Exit Sub Else End If Dim buf As String Dim j As Integer Dim GYOU As String Set xCur = Selection Dim OpenFileName As String Workbooks.Open Filename:="業務都合の為載せれません" GYOU = Application.InputBox("行を選択してください", "行指定") '<キャンセルの場合、処理を終わりにします。> If GYOU = "False" Then Exit Sub For j = 11 To 11 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(13, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 12 To 12 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(14, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 13 To 13 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(15, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 9 To 9 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(16, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 10 To 10 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(17, 6).PasteSpecial Paste:=xlPasteValues Next j ActiveWorkbook.Close SaveChanges:=False With xCur .Parent.Parent.Activate '元のブックへもどる .Parent.Activate '元のシートへもどる End With End Sub ど素人の為、めちゃくちゃな並びだとは思いますが一応現在の状態のマクロを載せておきます。 御指導の程、宜しくお願いします。

  • エクセルのVBAで教えて下さい。

    エクセルVBAで以下の方法のマクロが分からず、教えて頂きたいです。 まず、ブックAのシートAがあり、シートAのセルD3には号機No.を入力します(999などの数値のみ) 次にブックBのシートBがあり、このシートのD列にも号機No.が入力されています。 やりたい事はブックAのシートAのD3に号機No.を入力したら、ブックBのシートBのD列から同じ号機No.を 探し、当てはまる号機の行のI列、J列、K列、L列、M列をコピーし ブックAのシートAのF13、F14、F15、F16、F17、に貼り付けたいです。 それぞれの貼り付け先は K列⇒F13 L列⇒F14 M列⇒F15 I列⇒F16 J列⇒F17のようになります。 それとブックBのシートBのD列に入力されている号機No.は同じ数値が入力されている時があります。 この場合は必ず下にある号機No.のが最新ですので、そちらを読み取るようにしたいです。 例えば、4行目と8行目に同じ号機No.がある場合は8行目の方を読み取る。 現在は GYOU = Application.InputBox でターゲットの行番号を入力して その行の列をコピー・ペーストしている感じです。 Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim tmp() As String If Intersect(Target, Range("D3")) Is Nothing Then Exit Sub Else End If Dim buf As String Dim j As Integer Dim GYOU As String Set xCur = Selection Dim OpenFileName As String Workbooks.Open Filename:="業務都合の為載せれません" GYOU = Application.InputBox("行を選択してください", "行指定") '<キャンセルの場合、処理を終わりにします。> If GYOU = "False" Then Exit Sub For j = 11 To 11 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(13, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 12 To 12 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(14, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 13 To 13 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(15, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 9 To 9 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(16, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 10 To 10 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(17, 6).PasteSpecial Paste:=xlPasteValues Next j ActiveWorkbook.Close SaveChanges:=False With xCur .Parent.Parent.Activate '元のブックへもどる .Parent.Activate '元のシートへもどる End With End Sub ど素人の為、めちゃくちゃな並びだとは思いますが一応現在の状態のマクロを載せておきます。 御指導の程、宜しくお願いします。

  • EXCEL VBA で,プログラムが動かない.

    EXCEL2000のVBAでプログラムを組みました.(下に記す) 数千行に及ぶ数字のデータがあるのですが,20行に1回だけ,いらないデータが3行出てきます.その3行を削除していくプログラムです.Rangeのところで行を選んで欲しいのに,p列とq列を選んでしまうようです.RangeをRowsに変えたらエラーが出ました.こういう場合はどのように書けばいいのでしょうか.誰か教えてください.お願いします. Sub 削除() '20行ごとに入っている3行を削除していく. Dim i As Integer Dim p As Integer Dim q As Integer p = 21           'pの初期値は21 For i = 1 To 500 q = p + 2 r = "p:q" Range(r).Select Selection.Delete shift:=xlUp p = p + 20 Next i End Sub