第１８講　一般種法×末項確定法（魔方陣作成マクロVer.4）への挑戦

第９話　一般種法×末項確定法（魔方陣作成マクロVer.4の完成）
コード例

Dim mah1(12, 12) As Byte, mah2(12, 12) As Byte, x(144) As Byte, y(144) As Byte, p1(144) As Byte, p2(144) As Byte, a(12, 12) As Integer

Dim th(12, 12) As Byte

Dim n As Byte, cn As Integer, gk As Integer, tm As Byte

Private Sub CommandButton1_Click()

    Dim i, j As Integer

    n = Cells(3, 8)

    Rnd (-1)

    syokika

    zhy

    zhy1 (0)

    'zhykakunin

    ms1 (0)

End Sub

Sub syokika()

    Dim i As Byte

    Dim j As Byte

    For i = 0 To n - 1

        p1(i) = 0

        p2(i) = 0

        For j = 0 To n - 1

            th(i, j) = 0

        Next

    Next

    tm = 0

    sk = 0

    cn = 0

    gk = n

    For i = 0 To n - 1

        For j = 0 To n - 1

            a(i, j) = -1

        Next

    Next

End Sub

Sub zhy()

    Dim i As Byte

        For i = 0 To n - 1

        a(i, i) = i

    Next

    For i = 0 To n - 1

        If a(i, n - 1 - i) = -1 Then

            a(i, n - 1 - i) = gk

            gk = gk + 1

        End If

    Next

End Sub

Sub zhy1(g As Byte)

    Dim i As Byte

    For i = g + 1 To n - 1

        If a(g, i) = -1 Then

            a(g, i) = gk

            gk = gk + 1

        End If

    Next

    zhy2 (g)

    If tm = 1 Then Exit Sub

End Sub

Sub zhy2(g As Byte)

    Dim i As Byte

    Dim j As Byte

    For i = g + 1 To n - 1

        If a(i, g) = -1 Then

            a(i, g) = gk

            gk = gk + 1

        End If

    Next

    If g + 1 < n Then

        zhy1 (g + 1)

        If tm = 1 Then Exit Sub

    Else

        For i = 0 To n - 1

            For j = 0 To n - 1

                y(a(i, j)) = i

                x(a(i, j)) = j

            Next

        Next

        tm = 1

        Exit Sub

    End If

End Sub

Sub zhykakunin()

    Dim i As Byte

    For i = 0 To n * n - 1

        Cells(5 + y(i), 1 + x(i)) = i

    Next

End Sub

Sub ms1(g As Byte)

    Dim i As Integer, j As Byte, k As Byte, a As Byte, b As Byte, w As Integer, sa As Integer, h As Byte

    Dim ii As Integer, iii As Integer, kk As Byte

    a = x(g)

    b = y(g)

    If a = n - 1 And b = n - 1 Then

        w = 0

        For i = 0 To n - 2

            w = w + mah1(i, i)

        Next

        sa = Int(n * (n - 1) / 2) - w

        If sa < 0 Or sa > (n - 1) Then Exit Sub

        If p1(sa) >= n Then Exit Sub

        mah1(b, a) = sa

        p1(sa) = p1(sa) + 1

        ms1 (g + 1)

        p1(sa) = p1(sa) - 1

        Exit Sub

    End If

    If a = 0 And b = n - 1 Then

        w = 0

        For i = 0 To n - 2

            w = w + mah1(i, n - 1 - i)

        Next

        sa = Int(n * (n - 1) / 2) - w

        If sa < 0 Or sa > (n - 1) Then Exit Sub

        If p1(sa) >= n Then Exit Sub

        mah1(b, a) = sa

        p1(sa) = p1(sa) + 1

        ms1 (g + 1)

        p1(sa) = p1(sa) - 1

        Exit Sub

    End If

    If a = n - 2 And b = 0 Then

        w = 0

        For i = 0 To n - 3

            w = w + mah1(b, i)

        Next

        w = w + mah1(b, n - 1)

        sa = Int(n * (n - 1) / 2) - w

        If sa < 0 Or sa > (n - 1) Then Exit Sub

        If p1(sa) >= n Then Exit Sub

        mah1(b, a) = sa

        p1(sa) = p1(sa) + 1

        ms1 (g + 1)

        p1(sa) = p1(sa) - 1

        Exit Sub

    End If

    If a = 0 And b = n - 2 Then

        w = 0

        For i = 0 To n - 3

            w = w + mah1(i, a)

        Next

        w = w + mah1(n - 1, a)

        sa = Int(n * (n - 1) / 2) - w

        If sa < 0 Or sa > (n - 1) Then Exit Sub

        If p1(sa) >= n Then Exit Sub

        mah1(b, a) = sa

        p1(sa) = p1(sa) + 1

        ms1 (g + 1)

        p1(sa) = p1(sa) - 1

        Exit Sub

    End If

    If a = n - 1 And b > 0 And b < n - 1 Then

        w = 0

        For i = 0 To n - 2

            w = w + mah1(b, i)

        Next

        sa = Int(n * (n - 1) / 2) - w

        If sa < 0 Or sa > (n - 1) Then Exit Sub

        If p1(sa) >= n Then Exit Sub

        mah1(b, a) = sa

        p1(sa) = p1(sa) + 1

        ms1 (g + 1)

        p1(sa) = p1(sa) - 1

        Exit Sub

    End If

    If a > 0 And a < n - 1 And b = n - 1 Then

        w = 0

        For i = 0 To n - 2

            w = w + mah1(i, a)

        Next

        sa = Int(n * (n - 1) / 2) - w

        If sa < 0 Or sa > (n - 1) Then Exit Sub

        If p1(sa) >= n Then Exit Sub

        mah1(b, a) = sa

        p1(sa) = p1(sa) + 1

        If g + 1 < n * n Then

            ms1 (g + 1)

        Else

            ms2 (0)

        End If

        p1(sa) = p1(sa) - 1

        Exit Sub

    End If

    ii = n * Rnd

    For i = 0 To n - 1

        iii = (ii + i) Mod n

        mah1(b, a) = iii

        h = 0

        If p1(mah1(b, a)) >= n Then GoTo tobi

        p1(mah1(b, a)) = p1(mah1(b, a)) + 1

        h = 1

        ms1 (g + 1)

tobi:

        If h = 1 Then p1(mah1(b, a)) = p1(mah1(b, a)) - 1

    Next

End Sub

Sub ms2(g As Byte)

    Dim i As Integer, j As Byte, k As Byte, a As Byte, b As Byte, w As Integer, sa As Integer, h As Byte

    Dim ii As Integer, iii As Integer, kk As Byte, hs As Integer

    a = x(g)

    b = y(g)

    hs = mah1(b, a)

    If a = n - 1 And b = n - 1 Then

        w = 0

        For i = 0 To n - 2

            w = w + mah2(i, i)

        Next

        sa = Int(n * (n - 1) / 2) - w

        If sa < 0 Or sa > (n - 1) Then Exit Sub

        If th(mah1(b, a), sa) = 1 Then Exit Sub

        If p2(sa) >= n Then Exit Sub

        mah2(b, a) = sa

        p2(sa) = p2(sa) + 1

        th(mah1(b, a), mah2(b, a)) = 1

        ms2 (g + 1)

        p2(sa) = p2(sa) - 1

        th(mah1(b, a), mah2(b, a)) = 0

        Exit Sub

    End If

    If a = 0 And b = n - 1 Then

        w = 0

        For i = 0 To n - 2

            w = w + mah2(i, n - 1 - i)

        Next

        sa = Int(n * (n - 1) / 2) - w

        If sa < 0 Or sa > (n - 1) Then Exit Sub

        If th(mah1(b, a), sa) = 1 Then Exit Sub

        If p2(sa) >= n Then Exit Sub

        mah2(b, a) = sa

        p2(sa) = p2(sa) + 1

        th(mah1(b, a), mah2(b, a)) = 1

        ms2 (g + 1)

        p2(sa) = p2(sa) - 1

        th(mah1(b, a), mah2(b, a)) = 0

        Exit Sub

    End If

    If a = n - 2 And b = 0 Then

        w = 0

        For i = 0 To n - 3

            w = w + mah2(b, i)

        Next

        w = w + mah2(b, n - 1)

        sa = Int(n * (n - 1) / 2) - w

        If sa < 0 Or sa > (n - 1) Then Exit Sub

        If th(mah1(b, a), sa) = 1 Then Exit Sub

        If p2(sa) >= n Then Exit Sub

        mah2(b, a) = sa

        p2(sa) = p2(sa) + 1

        th(mah1(b, a), mah2(b, a)) = 1

        ms2 (g + 1)

        p2(sa) = p2(sa) - 1

        th(mah1(b, a), mah2(b, a)) = 0

        Exit Sub

    End If

    If a = 0 And b = n - 2 Then

        w = 0

        For i = 0 To n - 3

            w = w + mah2(i, a)

        Next

        w = w + mah2(n - 1, a)

        sa = Int(n * (n - 1) / 2) - w

        If sa < 0 Or sa > (n - 1) Then Exit Sub

        If th(mah1(b, a), sa) = 1 Then Exit Sub

        If p2(sa) >= n Then Exit Sub

        mah2(b, a) = sa

        p2(sa) = p2(sa) + 1

        th(mah1(b, a), mah2(b, a)) = 1

        ms2 (g + 1)

        p2(sa) = p2(sa) - 1

        th(mah1(b, a), mah2(b, a)) = 0

        Exit Sub

    End If

    If a = n - 1 And b > 0 And b < n - 1 Then

        w = 0

        For i = 0 To n - 2

            w = w + mah2(b, i)

        Next

        sa = Int(n * (n - 1) / 2) - w

        If sa < 0 Or sa > (n - 1) Then Exit Sub

        If th(mah1(b, a), sa) = 1 Then Exit Sub

        If p2(sa) >= n Then Exit Sub

        mah2(b, a) = sa

        p2(sa) = p2(sa) + 1

        th(mah1(b, a), mah2(b, a)) = 1

        ms2 (g + 1)

        p2(sa) = p2(sa) - 1

        th(mah1(b, a), mah2(b, a)) = 0

        Exit Sub

    End If

    If a > 0 And a < n - 1 And b = n - 1 Then

        w = 0

        For i = 0 To n - 2

            w = w + mah2(i, a)

        Next

        sa = Int(n * (n - 1) / 2) - w

        If sa < 0 Or sa > (n - 1) Then Exit Sub

        If th(mah1(b, a), sa) = 1 Then Exit Sub

        If p2(sa) >= n Then Exit Sub

        mah2(b, a) = sa

        p2(sa) = p2(sa) + 1

        th(mah1(b, a), mah2(b, a)) = 1

        If g + 1 < n * n Then

            ms2 (g + 1)

        Else

            For j = 0 To n - 1

                For k = 0 To n - 1

                    Cells(6 + k + Int(cn / 10) * (n + 1), 1 + j + (cn Mod 10) * (n + 1)) = n * mah1(j, k) + mah2(j, k) + 1

                Next

            Next

            cn = cn + 1

            Cells(4, 12) = cn

        End If

        p2(sa) = p2(sa) - 1

        th(mah1(b, a), mah2(b, a)) = 0

        Exit Sub

    End If

    ii = n * Rnd

    For i = 0 To n - 1

        iii = (ii + i) Mod n

        mah2(b, a) = iii

        h = 0

        If p2(mah2(b, a)) >= n Then GoTo tobi

        If th(mah1(b, a), mah2(b, a)) = 1 Then GoTo tobi

        p2(mah2(b, a)) = p2(mah2(b, a)) + 1

        th(mah1(b, a), mah2(b, a)) = 1

        h = 1

        ms2 (g + 1)

tobi:

        If h = 1 Then

            p2(mah2(b, a)) = p2(mah2(b, a)) - 1

            th(mah1(b, a), mah2(b, a)) = 0

        End If

    Next

End Sub

Private Sub CommandButton2_Click()

    Rows("5:2000").Select

    Selection.ClearContents

    Cells(4, 12).Select

    Selection.ClearContents

    Cells(1, 1).Select

End Sub

ダウンロード用参考ファイル


第８話へ　第１０話へ

　　

VBA講義第１部へ
vc++講義へ
vb講義へ
ＶＢ講義基礎へ
初心者のための世界で一番わかりやすいVisual C++入門基礎講座へ
初心者のための世界で一番わかりやすいVisual Basic入門基礎講座へ

数学研究室に戻る