Дана матрица А размерности (n*n). Определить, является ли она магическим квадратом - VBA

Узнай цену своей работы

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

составить программу, которая работает с любым допустимым набором данных. Входную информацию и результаты счёта вывести на печать, снабдив их соответствующими заголовками. Исходный массив заполнить с помощью датчика случайных чисел

Дана матрица А размерности (n*n). Определить, является ли она магическим квадратом, т.е. матрицей, в которой суммы элементов в строках и столбцах совпадают.

Помогите, пожалуйста!

Решение задачи: «Дана матрица А размерности (n*n). Определить, является ли она магическим квадратом»

textual
Листинг программы
  1. Sub vfhvfhMQ55()
  2. Dim a()
  3. Dim i&, j&, N&, M&
  4.    
  5. '--------------------
  6.    ActiveSheet.UsedRange.EntireRow.Delete
  7.    
  8.     'вводим данные
  9.    On Error Resume Next
  10.     N = Int(InputBox("Введите количество строк", "Ввод данных", 5))
  11.     M = Int(InputBox("Введите количество столбцов", "Ввод данных", 5))
  12.     If N <> M Then
  13.         Err.Clear
  14.         MsgBox "Введите одинаковую размерность N = M", vbInformation
  15.         Exit Sub
  16.     End If
  17.    
  18.     'наполняем массив случайными числами от 1 до 30
  19.    ReDim a(1 To N, 1 To M)
  20.     Randomize
  21.     For i = 1 To N
  22.         For j = 1 To M
  23.             a(i, j) = Int(30 * Rnd) + 1
  24.         Next
  25.     Next
  26.     Cells(2, 1).Resize(N, M) = a
  27.    
  28.     'считаем суммы по каждому столбцу
  29. Cells(2, 1).Resize(N, M) = a
  30.     For j = 1 To M
  31.         For i = 1 To N
  32.             s = s + a(i, j)
  33.         Next
  34.         With Cells(N + 2, j)
  35.             .Value = s
  36.             .Font.Bold = True
  37.             .Font.Italic = True
  38.             .Font.Color = vbRed
  39.         End With
  40.         s = 0
  41.      Next
  42.      
  43.    'считаем суммы по каждой строке
  44. Cells(2, 1).Resize(N, M) = a
  45.     For i = 1 To N
  46.         For j = 1 To M
  47.             p = p + a(i, j)
  48.         Next
  49.         With Cells(i + 1, M + 1)
  50.             .Value = p
  51.             .Font.Bold = True
  52.             .Font.Italic = True
  53.             .Font.Color = vbBlue
  54.         End With
  55.         p = 0
  56.      Next
  57.      
  58.      'считаем сумму эл-тов главной диагонали
  59. q = 0
  60. Cells(2, 1).Resize(N, M) = a
  61.     For i = 1 To N
  62.         j = i
  63.         Cells(i + 1, j).Interior.Color = vbGreen
  64.          q = q + a(i, j)
  65.     Next
  66.     Cells(N + 2, M + 1) = q
  67.     Cells(N + 2, M + 1).Font.Color = vbGreen
  68.    
  69.     'считаем сумму эл-тов побочной диагонали
  70. v = 0
  71. Cells(2, 1).Resize(N, M) = a
  72.     For i = 1 To N
  73.         j = N - i + 1
  74.         Cells(i + 1, j).Interior.Color = vbYellow
  75.          v = v + a(i, j)
  76.     Next
  77.     Cells(1, M + 1) = v
  78.     Cells(1, M + 1).Font.Color = vbGreen  'жёлтый не смотрится!
  79.    
  80.    'проверка по столбцам через MsgBox
  81.   For j = 1 To M
  82.        i = N + 2
  83.        If Cells(N + 2, 1) <> Cells(N + 2, j) Then
  84.        MsgBox "Первый этап: суммы по столбцам не совпадают!"
  85.        Exit Sub
  86.        End If
  87.     Next
  88.        
  89.        'проверка по строкам через MsgBox
  90.   For i = 1 To N
  91.        j = M + 1
  92.        If Cells(2, M + 1) <> Cells(i, M + 1) Then
  93.        MsgBox "Второй этап: суммы по строкам не совпадают!"
  94.        Exit Sub
  95.        End If
  96.     Next
  97.    
  98.     'проверка по диагоналям через MsgBox
  99.   For i = 1 To 2
  100.        j = M + 1
  101.        If Cells(1, M + 1) <> Cells(N + 2, M + 1) Then
  102.        MsgBox "Третий этап: суммы по диагоналям не совпадают!"
  103.        Exit Sub
  104.        Else: Cells(1, M + 1) = Cells(N + 2, M + 1)
  105.        MsgBox "С Вас бутылка! Магический квадрат!"
  106.        End If
  107.     Next
  108.        
  109. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

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

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы