Поиск строки в двумерном массиве состоящей из элементов равных числу а - VB
Формулировка задачи:
Определить, есть ли в данном двумерном массиве строка (столбец), состоящая только из элементов равных числу А.
Решение задачи: «Поиск строки в двумерном массиве состоящей из элементов равных числу а»
textual
Листинг программы
Option Explicit
Option Base 1
'
' © Антихакер32™
'
'Определить, есть ли в данном двумерном массиве строка (столбец),
'состоящая только из элементов равных числу А.
Dim WithEvents cm1 As CommandButton, WithEvents cm2 As CommandButton
Dim b As Boolean
Private Sub cm1_Click()
Form_Activate
End Sub
Private Sub cm2_Click()
b = False: Form_Activate
End Sub
Private Sub Form_Activate()
Const matrix = 500, l = 5
Dim arr(l, l), X&, Y&, n&, b1 As Boolean, i&, o As Object
Static c(l * l + l + 2) As CommandButton, s$
If b Then GoTo povtor
For Each o In Me: Controls.Remove o: Next
Do: Do
s = InputBox("Введите число A от 1 до " & l & " ..", , "3")
Loop While Not IsNumeric(s)
b1 = s < 1 Or s > l
If b1 Then If MsgBox("Неверно, продолжить? ..", vbYesNo Or vbInformation) = vbNo Then Exit Sub
Loop While b1
povtor:
Randomize Timer
Do: DoEvents
For Y = 1 To l
For X = 1 To l
arr(X, Y) = 1 + Fix(Rnd * l)
If b = False Then
i = (Y - 1) * l + X
Set c(i) = Controls.Add("vb.CommandButton", "c" & X & Y)
c(i).Move (X - 1) * matrix, (Y - 1) * matrix, matrix, matrix
c(i).Visible = True
End If
Next
Next
If b = False Then
i = (Y - 1) * l + X
Set c(i) = Controls.Add("vb.CommandButton", "c" & X & Y & 1)
Set cm1 = c(i): c(i).Move 0, (Y - 1) * matrix, matrix * 2, matrix
c(i).Caption = "Повтор": c(i).Visible = True
Set c(i) = Controls.Add("vb.CommandButton", "c" & X & Y & 2)
Set cm2 = c(i): c(i).Move matrix * 2, (Y - 1) * matrix, matrix * 2, matrix
c(i).Caption = "Ввод": c(i).Visible = True
Me.Refresh
End If
b = True
'''
For Y = 1 To l: n = 0: For X = 1 To l
If arr(X, Y) = s Then n = n + 1: If n = l Then GoTo stroka
Next: Next
For X = 1 To l: n = 0: For Y = 1 To l
If arr(X, Y) = s Then n = n + 1: If n = l Then GoTo stolbex
Next: Next
Loop
Exit Sub
stroka:
n = Y
For Y = 1 To l: For X = 1 To l
i = (Y - 1) * l + X
c(i).FontSize = IIf(n = Y, 14, 9)
c(i).FontBold = IIf(n = Y, 1, 0)
c(i).Caption = arr(X, Y)
Next: Next
Exit Sub
stolbex:
n = X
For Y = 1 To l: For X = 1 To l
i = (Y - 1) * l + X
c(i).FontSize = IIf(n = X, 14, 9)
c(i).FontBold = IIf(n = X, 1, 0)
c(i).Caption = arr(X, Y)
Next: Next
Exit Sub
End Sub