Как написать код программы, подбирающей магический квадрат 5х5 перебором? - VBA

Формулировка задачи:

Здравствуйте! Прошу помощи. Не знаю, как написать код программы, подбирающей магический квадрат 5х5 перебором для VBA. Помогите, пожалуйста. Есть наработки ниже
ПРОГРАММА ПОСТРОЕНИЯ МАГИЧЕСКИХ КВАДРАТОВ Разработанная программа на языке Turbo Pascal позволяет строить магические квадраты любой четности при n≤19. Можно брать и большие значения n, но при n>19 квадрат не помещается на экране монитора). http://levvol.ru/ar2.php
Program MagicSquares; 
 
{Построение магических квадратов} 
 
Uses CRT; 
Type a_type=array[1..50,1..50] of integer; 
Var i,j,n:integer; 
a:a_type; 
t:boolean; 
{логическая переменная true (правда) или false (ложь)} 
x,y:integer; 
Label 1; 
{метка} 
Procedure Print(n:integer; a:a_type); 
{процедура вывода} 
Var i,j:integer; 
Begin 
for i:=1 to n do begin 
for j:=1 to n do write(a[i,j]:4); 
writeln(''); 
end; 
end; 
Procedure WinSh(x1,y1,x2,y2,col1,col2:word); 
{процедура вывода окна} 
Begin 
TextBackGround(black); 
Window (x1+1,y1+1,x2+1,y2+1); 
{тень - черный прямоугольник} 
ClrScr; 
TextBackGround(col1); 
Window(x1,y1,x2,y2); 
ClrScr; 
TextColor(col2); 
{рисование рамки} 
GotoXY(2, 1); write('г'); 
for i:=1 to x2-x1-2 do write('='); 
GotoXY(x2-x1,1); write('='); 
GotoXY(2,y2-y1+1); 
write('L'); for i:=1 to x2-x1-2 do write('='); 
GotoXY(x2-x1,y2-y1+1); write('-'); 
for j:=2 to y2-y1 do begin 
 GotoXY(2,j); write('¦'); 
 GotoXY(x2-x1,j); write('¦'); 
 end; 
End; 
Procedure OddMagic(n:integer; var a:a_type); 
{Процедура формирования магического квадрата при нечетном n. Описание алгоритма в сопроводительной записке } 
Var 
i,j,k:integer; 
p,l:integer; 
Begin 
for i:=1 to n do 
for j:=1 to n do a[i,j]:=0; 
j:=n div 2 +1; p:=sqr(n); i:=1; a[i,j]:=1; 
for l:=2 to p do begin 
i:=i-1; 
j:=j+1; 
if (i=0) and (j<>n+1) then i:=n; 
if (j=n+1) and (i<>0) then j:=1; 
if ((i=0) and (j=n+1)) or (a[i,j]<>0) then 
{важен порядок условий!} 
begin 
 i:=i+2; 
 j:=j-1; 
 end; 
a[i,j]:=l; 
end; 
end; 
Procedure Two (n:integer; var a:a_type); 
{Процедура построения квадрата при n обычной четности: n=6,10,14,18...} 
Var 
u,i,j,k,m,z:integer; 
b:a_type; 
Begin 
u:= n div 2; 
m:=(u-1) div 2; 
OddMagic(u,b); 
{вызов процедуры построения квадрата при нечет-ном u} 
k:=u*u; 
for i:=1 to n do 
for j:=1 to n do begin 
if (i>=1) and (i<=u) and (j>=1) and (j<=u) then a[i,j]:=b[i,j]; 
if (i>=u+1) and (i<=n) and (j>=u+1) and (j<=n) then a[i,j]:=b[i-u,j-u]+k; 
if (i>=1) and (i<=u) and (j>=u+1) and (j<=n) then a[i,j]:=b[i,j-u]+2*k; 
if (i>=u+1) and (i<=n) and (j>=1) and (j<=u) then a[i,j]:=b[i-u,j]+3*k; 
end; 
for i:=1 to u do 
if i=u div 2+1 then begin 
j:= u div 2+1; 
for k:=1 to m do begin 
z:=a[i,j]; 
{обмен данными} 
a[i,j]:=a[i+u,j]; 
a[i+u,j]:=z; 
j:=j-1 
end; 
end 
else begin 
j:=1; 
for k:=1 to m do begin 
z:=a[i,j]; 
{обмен данными} 
a[i,j]:=a[i+u,j]; 
a[i+u,j]:=z; 
j:=j+1 
end; 
end; 
j:=n; 
for k:=1 to m-1 do begin 
for i:=1 to u do begin 
z:=a[i,j]; a[i,j]:=a[i+u,j]; a[i+u,j]:=z; 
{обмен данными} 
end; 
j:=j-1 
end; 
end; 
Procedure Four(n:integer; var a:a_type); 
{Процедура построения квадрата при n двойной четности: n=4,8,12,16...} 
Var i,j,k:integer; 
p,l:integer; 
i1,j1,x,y:integer; 
Begin 
l:=1; p:=n*n; 
for i:=1 to n do 
for j:=1 to n do begin 
a[i,j]:=l; 
inc(l) 
{l:=l+1} 
end; 
i:=2; 
while i<=n-2 do begin 
if i mod 4=0 then j:=4 
else j:=2; 
while j<=n-2 do begin 
for i1:=0 to 1 do 
for j1:=0 to 1 do begin 
y:=i+i1; x:=j+j1; 
a[y,x]:=p-a[y,x]+1; 
end; 
j:=j+4; 
end; 
i:=i+2 
end; 
k:=4; 
while k<=n-4 do begin 
a[1,k]:=p-a[1,k]+1; a[1,k+1]:=p-a[1,k+1]+1; 
a[n,k]:=p-a[n,k]+1; a[n,k+1]:=p-a[n,k+1]+1; 
a[k,1]:=p-a[k,1]+1; a[k+1,1]:=p-a[k+1,1]+1; 
a[k,n]:=p-a[k,n]+1; a[k+1,n]:=p-a[k+1,n]+1; 
k:=k+4 
end; 
a[1,1]:=p-a[1,1]+1; 
a[n,n]:=p-a[n,n]+1; 
a[1,n]:=p-a[1,n]+1; 
a[n,1]:=p-a[n,1]+1; 
end; 
Procedure Test(n:integer; a:a_type; var t:boolean; var x,y:integer); 
{Процедура проверки сумм по строкам, столбцам и диагоналям квад-рата} 
Var s,z:array [1..50] of integer; 
{массивы для записи сумм по строкам и столбцам} 
sd,zd:integer; 
i,j,k:integer; 
sum:integer; 
Begin 
sum:=n*(n*n+1) div 2; 
for k:=1 to n do begin 
s[k]:=0; 
z[k]:=0 
end; 
sd:=0; zd:=0; 
for i:=1 to n do 
for j:=1 to n do begin 
s[i]:=s[i]+a[i,j]; 
z[j]:=z[j]+a[i,j] 
end; 
for k:=1 to n do begin 
sd:=sd+a[k,k]; 
zd:=zd+a[k,n-k+1]; 
end; 
k:=1; t:=true; 
while (k<=n) and (t) do begin 
if s[k]<>sum then begin 
t:=false; 
{ошибка по строкам} 
y:=1; 
x:=k 
{номер строки} 
end; 
k:=k+1 
end; 
if (t) then begin 
k:=1; 
while (k<=n) and (t) do begin 
if z[k]<>sum then begin 
t:=false; 
{ошибка по столбцам} 
y:=2; 
x:=k 
{номер столбца} 
end; 
k:=k+1 
end; 
end; 
if (t) then if sd<>sum then begin 
t:=false; 
{ошибка по главной диагонали} 
y:=3; 
x:=0; 
end; 
if (t) then if zd<>sum then begin 
t:=false; 
{ошибка по побочной диагонали} 
y:=4; 
x:=0; 
end; 
if t then writeln('Тест прошел успешно'); 
End; 
 
Begin 
{Основная программа} 
1: 
TextBackGround(blue); 
ClrScr; 
WinSh(20,3,60,6,blue,white); 
GotoXY(9,2); write('Магический квадрат'); 
GotoXY(10,3); write('(c) 2006 г.'); 
Window(1,1,80,25); TextColor(yellow); TextBackGround(blue); 
GotoXY(60,18); write(' 8 ¦ 1 ¦ 6'); 
GotoXY(60,19); write('===+===+==='); 
GotoXY(60,20); write(' 3 ¦ 5 ¦ 7'); 
GotoXY(60,21); write('===+===+==='); 
GotoXY(60,22); write(' 4 ¦ 9 ¦ 2'); 
TextColor(white); TextBackGround(white); 
for x:=2 to 79 do begin 
GotoXY(x,25); 
write(' '); 
end; 
GotoXY(5,25); 
write('Размерность =0 - конец работы программы. Рекомендуем размерность от 3 до 19'); 
Winsh(30,10,50,12,cyan,white); 
repeat 
TextColor(white); 
GotoXY(4,2); write('Размерность=');readln(n); 
until (n<>1) and (n<>2); 
{квадрат для n=1 и для n=2 строить нельзя} 
if n=0 then halt; 
{выход из программы} 
{Если n-нечетно, то OddMag, иначе ...} 
if odd(n) then OddMagic(n,a) 
else if n mod 4=0 then Four(n,a) 
else Two(n,a); 
TextBackGround(blue); 
Window(1,1,80,25); 
ClrScr; 
TextColor(yellow); 
ClrScr; 
{вывод} 
Writeln('Магический квадрат ',n,'x',n); 
Print(n,a); 
writeln(''); 
Test(n,a,t,x,y); 
{Процедура тестирования квадрата} 
if (t) then 
writeln('Суммы по столбцам, строкам и диагоналям =',n*(n*n+1) div 2) 
else begin 
writeln('Ошибка'); 
case y of 
1: writeln('Ошибка в строке ',x); 
2: writeln('Ошибка в столбце ',x); 
3: writeln('Ошибка по главной диагонали'); 
4: writeln('Ошибка по побочной диагонали') 
end; 
end; 
readln; 
goto 1; 
End.
Добавлено через 6 часов 26 минут
Сообщение от Alex77755
Это противоречит главному принципу магического квадрата!
Alex77755, покажите нам новичкам, пожалуйста, как задать кодом построение магического квадрата для VBA. Блесните познаниями, если они есть. Достаточно схемы для матрицы 3х3. Остальное будет по аналогии. Согласно сумме арифметической прогрессии, определяем сумму ряда (столбца, строки и диагонали) для каждой размерности: • Матрица 2х2: ((1 + 4) * 4/2)/2 = 2,5 (не целое) — построить магический квадрат нельзя! • Матрица 3х3: ((1 + 9) * 9/2)/3 = 15 — построить магический квадрат можно! • Матрица 4х4: ((1 + 16) * 16/2)/4 = 34 — построить магический квадрат можно! • Матрица 5х5: ((1 + 25) * 25/2)/5 = 65 — построить магический квадрат можно! • Матрица 6х6: ((1 + 36) * 36/2)/6 = 111— построить магический квадрат можно! • И т. п. и т. д.

Код к задаче: «Как написать код программы, подбирающей магический квадрат 5х5 перебором? - VBA»

textual
Function Create_Magic(n As Integer) As Integer()
Dim R() As Integer
 
    ReDim R(0 To n - 1, 0 To n - 1) As Integer
    
    ss% = (n - 1) \ 2
    nn% = 1
    
    For i% = 0 To (n - 1)
        For j% = 0 To n - 1
            X% = (-ss% + i% + j% + n) Mod n
            y% = (ss% + i% - j% + n) Mod n
            R(X%, y%) = nn
            nn = nn + 1
        Next j%
    Next i%
    
    Create_Magic = R
 
End Function
 
Sub Test()
Dim X() As Integer
 
    X = Create_Magic(5)
    
    For i% = 0 To 4
        For j% = 0 To 4
            Cells(i% + 1, j% + 1).Value = X(i%, j%)
        Next j%
    Next i%
 
End Sub

6   голосов, оценка 4.167 из 5


СОХРАНИТЬ ССЫЛКУ