Фильтрация двумерного массива

@SArthur · Регистрация: 03.01.2010

Студворк — интернет-сервис помощи студентам

В общем ситуация следующая: я создал двумерный массив состоящий из рэндомных чисел (размерность массива и диапазон чисел задаю с клавиатуры), после чего отфильтровал его по заданному условию и обнулил все те значения которые не подходили по условиям фильтра. В результате получил тот же массив но с нулями на тех местах где раньше стояли значения не подходящие под условия фильтра.

Уважаемые знатоки! Внимание, вопрос! - как из получившегося массива сделать двумерный массив но другой размерности (размерность нужно задать с клавиатуры) так чтобы исчезли все нули, а на их место стали другие числа из массива ?

Заранее благодарю всех тех кто хоть как-то поможет мне в решении это не легкой для меня задачи =))

Спасибо

@yaser · 03.01.2010, 08:16

А какие другие числа? И какой другой размерности? А если в какой-либо строке нулей больше, чем в остальных? И, вообще, желательно образец выложить сюда.

@SArthur · 03.01.2010, 11:36 **[ТС]**

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Dim MaxI As Integer, i As Integer, a As Integer, b As Integer
Dim MaxJ As Integer, j As Integer, max As Integer, c As Integer, d As Integer, e As Integer, x As Integer, y As Integer, z As Integer
Dim matr(10000, 10000) As Integer
Dim matr2(10000, 10000) As Integer
Dim matr3(10000, 10000) As Integer
Dim MaxA As Integer
Dim MaxB As Integer
 
Private Sub CommandButton1_Click()
MaxI = TextBox2.Text 'çàäàåò êîëè÷åñòâî ñòðîê
MaxJ = TextBox3.Text 'ñòîëáöîâ
a = TextBox4.Text
b = TextBox5.Text
For i = 1 To MaxI
 For j = 1 To MaxJ
 Randomize
 matr(i, j) = Int(Rnd * (b - a)) + a
 Worksheets("Blank").Cells(i + 1, j + 1).Value = matr(i, j)
 Next j
Next i
End Sub
 
Private Sub CommandButton2_Click()
Cells.Clear
For i = 1 To MaxI
 For j = 1 To MaxJ
 Worksheets("Blank").Cells(i + 1, j + 1).Value = ""
 Next j
Next i
End Sub
 
Private Sub CommandButton3_Click()
e = 0
max = 0
For i = 1 To MaxI
 For j = 1 To MaxJ
 If matr(i, j) > max Then
 max = matr(i, j)
 End If
 Next j
Next i
TextBox1.Text = max
c = max / 5
d = max / 2
For i = 1 To MaxI
 For j = 1 To MaxJ
 If matr(i, j) <= c Or matr(i, j) >= d Then
 matr2(i, j) = matr(i, j)
 Else: matr2(i, j) = 0
 End If
 Next j
Next i
For i = 1 To MaxI
 For j = 1 To MaxJ
 If matr2(i, j) < 0 Or matr2(i, j) > 0 Then
 e = e + 1
 Worksheets("Blank").Cells(i + MaxI + 2, j + 1).Value = matr2(i, j)
 End If
 Next j
Next i
TextBox6.Text = e
End Sub

Вот это то что я написал. Так как я програмил последний раз в универе лет пять назад, прошу не задавайте вопросов "А зачем тебе столько переменных?" или "А что делает вот эта строчка в твоем коде?", на эти вопросы отвечаю сразу - програмер из меня никакой, поэтому писал код исходя из того что помнил.

В принципе из этого должно быть понятно что в итоге получается, а именно, при нажатии кнопки три происходит фильтрация и на листе под старым массивом появляется новый (той же размерности) но на месте где в старом массиве были числа которые не подходят под параметры фильтра стоят нули.

Вопрос остается неизменным - нужно создать третий массив который получится из второго, но в нем должны быть все числа кроме нулей, из чего логично следует что размерность массива может измениться. У меня в приведенной части кода есть кусочек где программа считает сколько не нулевых значений получается после фильтрации и исходя из этого можно задать с клавиатуры размерность новой матрицы.

Вроде разжевал подробно. Если будут вопросы, пишите =)))

@yaser · 04.01.2010, 12:35

Переработал Ваши наработки (извиняюсь за тавтологию). Все commandbutton-ы свёл в один блок, некоторые строки Вашего кода не стал удалять, а закомментарил (чтобы было видно, в чём изменения), и, для наглядности результата кое-что переделал.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Private Sub CommandButton1_Click()
Dim MaxI As Integer, a As Integer, b As Integer, c As Integer, d As Integer
Dim MaxJ As Integer, i As Integer, j As Integer, max As Integer, e As Integer
'Dim matr(10000, 10000) As Integer
'Dim matr2(10000, 10000) As Integer
Dim matr() As Integer
Dim matr2() As Integer
'Dim matr3(10000, 10000) As Integer
'Dim MaxA As Integer
'Dim MaxB As Integer
 
 
  Cells.Clear
 
'  MaxI = TextBox2.Text 'задает количество строк
'  MaxJ = TextBox3.Text 'столбцов
  
  MaxI = InputBox("Введите количество строк: ") 'задает количество строк
  MaxJ = InputBox("Введите количество столбцов: ") 'столбцов
  
'  a = TextBox4.Text
'  b = TextBox5.Text
  
  a = InputBox("Введите первое число: ")
  b = InputBox("Введите второе число: ")
  
  ReDim matr(MaxI, MaxJ)
  For i = 1 To MaxI
      For j = 1 To MaxJ
          Randomize
          matr(i, j) = Int(Rnd * (b - a)) + a
'          Worksheets("Blank").Cells(i + 1, j + 1).Value = matr(i, j)
          Worksheets(1).Cells(i + 1, j + 1) = matr(i, j)
      Next j
  Next i
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
'  Cells.Clear
'  For i = 1 To MaxI
'      For j = 1 To MaxJ
'          Worksheets("Blank").Cells(i + 1, j + 1).Value = ""
'      Next j
'  Next i
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
  e = 0
  max = 0
  For i = 1 To MaxI
      For j = 1 To MaxJ
          If matr(i, j) > max Then
             max = matr(i, j)
          End If
      Next j
  Next i
'  TextBox1.Text = max
  MsgBox (max)
  c = max / 5
  d = max / 2
  
  ReDim matr2(MaxI, MaxJ)
  For i = 1 To MaxI
      For j = 1 To MaxJ
          If matr(i, j) <= c Or matr(i, j) >= d Then
             matr2(i, j) = matr(i, j)
          Else: matr2(i, j) = 0
          End If
      Next j
  Next i
  
  For i = 1 To MaxI
      For j = 1 To MaxJ
'          If matr2(i, j) < 0 Or matr2(i, j) > 0 Then
          If matr2(i, j) <> 0 Then
             e = e + 1
'             Worksheets("Blank").Cells(i + MaxI + 2, j + 1).Value = matr2(i, j)
             Worksheets(1).Cells(i + MaxI + 2, j + 1) = matr2(i, j)
          End If
      Next j
  Next i
 
'  TextBox6.Text = e
  MsgBox ("Количество ненулевых значений: " & e)
' Здесь, я так понимаю, будет запрос, в какой размерности выводить отфильтрованный массив?
 
End Sub

Как видите, в результате фильтрации получается следующая картина:
Полученный массив не является "нормальным", т.к. содержит пустые ячейки. Количество пустых ячеек в каждой строке м.б. разным. Теперь вопрос: как Вы хотите определить размерность выводимого массива, если, например, количество ненулевых значений в нём будет под несколько тысяч? Или Вам нужна ещё прога, определяющая, на какое число (в заданных пределах) без остатка делится общее количество значений массива?

Добавлено через 4 часа 50 минут
P.S. Да, надо ещё помнить, что есть числа, которые делятся только на 1 и на себя. Как тогда выводить такой массив (например, из 29 чисел)?

@SArthur · 04.01.2010, 13:03 **[ТС]**

Огромное спасибо за переработку кода!!! =)

Вот впринципе само задание которое нужно сделать:

1. Сформировать на листе Excel матрицу случайных чисел X, распределенных равномерно в диапазоне [A1;A2]. Значения A1 и A2 задаются с клавиатуры.

2. Провести фильтрацию полученных чисел X. Вид фильтрации: X не пренадлежит [max/5;max/2].

3. Заполнить квадратную матрицу размерностью k числами, полученными после фильтрации. Размерность k вводится с клавиатуры.

Как видно, первые два пункта я с горем пополам написал и Вы мне поправили. Вся загвоздка в третьем пункте. Насколько я понимаю там не важно сколько значений будет получено, ведь датчик не нулевых значений у нас уже написан и он выдает их количество. Исходя из этого количества можно расчитать квадратную матрицу (например если не нулевых значений получилось 13, то ближайшая квадратная матрица 4x4 - 16 значений, так как у нас только 13 то оставшиеся последние ячейки нужно заполнить тупо нолями) и построить ее.

@yaser · 05.01.2010, 07:32

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
Private Sub CommandButton1_Click()
Dim MaxI As Integer, a As Integer, b As Integer, c As Integer, d As Integer
Dim MaxJ As Integer, i As Integer, j As Integer, max As Integer, e As Integer
Dim nAnswer As Integer, nNewArrDimension As Integer, nRow As Integer, nCol As Integer
Dim matr() As Integer, matr2() As Integer, NewArr() As Integer
 
  On Error GoTo ErrorHandler
  Cells.Clear
  
  MaxI = InputBox("Введите количество строк: ") 'задает количество строк
  MaxJ = InputBox("Введите количество столбцов: ") 'столбцов
  a = InputBox("Введите первое число: ")
  b = InputBox("Введите второе число: ")
  
  ReDim matr(MaxI, MaxJ)
  For i = 1 To MaxI
      For j = 1 To MaxJ
          Randomize
          matr(i, j) = Int(Rnd * (b - a)) + a
          Worksheets(1).Cells(i + 1, j + 1) = matr(i, j)
      Next j
  Next i
 
  e = 0
  max = 0
  For i = 1 To MaxI
      For j = 1 To MaxJ
          If matr(i, j) > max Then
             max = matr(i, j)
          End If
      Next j
  Next i
  MsgBox (max)
  c = max / 5
  d = max / 2
  
  ReDim matr2(MaxI, MaxJ)
  For i = 1 To MaxI
      For j = 1 To MaxJ
          If matr(i, j) <= c Or matr(i, j) >= d Then
             matr2(i, j) = matr(i, j)
          Else: matr2(i, j) = 0
          End If
      Next j
  Next i
  
  For i = 1 To MaxI
      For j = 1 To MaxJ
          If matr2(i, j) <> 0 Then
             e = e + 1
             Worksheets(1).Cells(i + MaxI + 2, j + 1) = matr2(i, j)
          End If
      Next j
  Next i
 
  MsgBox ("Количество ненулевых значений: " & e)
 
  nAnswer = MsgBox("Вывести новый массив на экран?", vbYesNo + vbQuestion + vbDefaultButton1, _
                   "Вывод нового массива")
  
  If nAnswer = vbNo Then Exit Sub
 
  nNewArrDimension = 2
  While nNewArrDimension * nNewArrDimension < e
        nNewArrDimension = nNewArrDimension + 1
  Wend
  
  ReDim NewArr(nNewArrDimension, nNewArrDimension)
  nRow = 1
  nCol = 1
  
  For i = 1 To MaxI ' Сначала заполняем новый массив тем, что есть
      For j = 1 To MaxJ
          If Worksheets(1).Cells(i + MaxI + 2, j + 1) <> "" Then
             If nCol <= nNewArrDimension Then
                NewArr(nRow, nCol) = Worksheets(1).Cells(i + MaxI + 2, j + 1)
'               Если есть желание контролировать правильность формирования
'               нового массива, снимите комметарий со следующих строк
'                Worksheets(1).Cells(MaxI * 3 + 2 + nRow, nCol + 1) = NewArr(nRow, nCol)
                nCol = nCol + 1
             Else
                nRow = nRow + 1
                nCol = 1
                NewArr(nRow, nCol) = Worksheets(1).Cells(i + MaxI + 2, j + 1)
'                Worksheets(1).Cells(MaxI * 3 + 2 + nRow, nCol + 1) = NewArr(nRow, nCol)
                nCol = nCol + 1
             End If
          End If
      Next j
  Next i
  
' Теперь проверяем, если массив заполнен не до конца - дописываем нули
  i = nRow
  j = nCol
  
  If nRow <= nNewArrDimension Then
     For nRow = i To nNewArrDimension
         For nCol = j To nNewArrDimension
             NewArr(nRow, nCol) = 0
         Next
         j = 1
     Next
  End If
     
  For nRow = 1 To nNewArrDimension ' Выводим на экран
      For nCol = 1 To nNewArrDimension
          Worksheets(1).Cells(MaxI * 3 + 2 + nRow, nCol + 1) = NewArr(nRow, nCol)
      Next
  Next
  
ErrorHandler:
 
End Sub

Вообще-то, для оптимизации кода я бы использовал некоторые переменные многократно в разных частях программы, но оставил по-Вашему, чтобы было понятнее, где что. Да, кстати, определение размерности матрицы k я реализовал программно, но можно и организовать диалог с юзером, подсказав ему ближайшую подходящую размерность, но, если он захочет другую - тоже не проблема.

@SArthur · 05.01.2010, 08:11 **[ТС]**

И еще раз Огромнейшее спасибо Вам за помощь !!!! Только я не понял один момент, а где ввод размерности k с клавиатуры ? =)

@yaser · 05.01.2010, 13:38

Сообщение от SArthur

Только я не понял один момент, а где ввод размерности k с клавиатуры ? =)

Ещё раз: определение размерности матрицы k я реализовал программно, но можно и организовать диалог с юзером, подсказав ему ближайшую подходящую размерность, но, если он захочет другую - тоже не проблема.

Могу подсказать: через InputBox запрашиваете размерность, это значение используете в формировании нового массива. Строки 63-66 - автоматическое вычисление новой размерности. Заменяете их на диалог с юзером, и - всё!

@SArthur · 05.01.2010, 23:25 **[ТС]**

Спасибо за разъяснение, сейчас буду пробовать =)

Добавлено через 6 часов 17 минут
Я тут пытаюсь отсортировать полученный массив методом пузырька, по возрастанию, но ничего не получается. Вот код который я применяю

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 For nRow = 1 To nNewArrDimension
      For nCol = 1 To aNewArrDimension + 1
      If NewArr(nRow, nCol) > NewArr(nRow, nCol + 1) Then
      Tmp = NewArr(nRow, nCol)
      NewArr(nRow, nCol) = NewArr(nRow, nCol + 1)
      NewArr(nRow, nCol + 1) = Tmp
      End If
      Next nCol
  Next nRow
   
  For nRow = 1 To nNewArrDimension
      For nCol = 1 To aNewArrDimension
      Worksheets(1).Cells(MaxI * 4 + 2, nCol + 1) = NewArr(nRow, nCol)
      Next nCol
  Next nRow

Программа и ошибки не выдает и никак не реагирует на этот код. Можете дать какой нибудь совет ?

Добавлено через 2 часа 3 минуты
Прошу прощения за глупость которую я написал, самому стыдно =))) Я переписал код, вот он:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
For i = 1 To nNewArrDimension
      For j = 1 To nNewArrDimension
          For nRow = 1 To nNewArrDimension - 1
              For nCol = 1 To nNewArrDimension - 1
              If NewArr(nRow, nCol) > NewArr(nRow, nCol + 1) Then
              Tmp = NewArr(nRow, nCol)
              NewArr(nRow, nCol) = NewArr(nRow, nCol + 1)
              NewArr(nRow, nCol + 1) = Tmp
              End If
       If NewArr(nRow, nCol + 1) > NewArr(nRow + 1, 1) Then
       Tmp = NewArr(nRow, nCol + 1)
       NewArr(nRow, nCol + 1) = NewArr(nRow + 1, 1)
       NewArr(nRow + 1, 1) = Tmp
       End If
              Next nCol
          Next nRow
      Next j
  Next i
  
  For nRow = 1 To nNewArrDimension
      For nCol = 1 To nNewArrDimension
      Worksheets(1).Cells(MaxI * 5 + 2 + nRow, nCol + 1) = NewArr(nRow, nCol)
      Next nCol
  Next nRow

Но осталась одна проблема, программа не все нули убирает в начало. То есть она часть нулей получившихся в конечной матрице ставит в начало, потом идет возрастание массива и часть в конце массива. Не могу понять почему так ?

@yaser · 07.01.2010, 08:09

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
  For i = 1 To nNewArrDimension
      For j = 1 To nNewArrDimension
          nMin = NewArr(i, j)
'         Ищем минимальное значение во всём массиве
          For nRow = i To nNewArrDimension
              If nRow = i Then
                 nC = j + 1
              Else: nC = 1
              End If
              For nCol = nC To nNewArrDimension
                  If NewArr(nRow, nCol) < nMin Then
                     Tmp = nMin
                     nMin = NewArr(nRow, nCol)
                     NewArr(nRow, nCol) = Tmp
                  End If
              Next nCol
          Next nRow
          NewArr(i, j) = nMin
          
'         Следующие 5 строк для контроля процесса переформирования массива
          For nR = 1 To nNewArrDimension
              For nC = 1 To nNewArrDimension
                  Worksheets(1).Cells(MaxI * 5 + 2 + nR, nC + 1) = NewArr(nR, nC)
              Next
          Next
          
      Next j
  Next i
  
  For nRow = 1 To nNewArrDimension
      For nCol = 1 To nNewArrDimension
      Worksheets(1).Cells(MaxI * 5 + 2 + nRow, nCol + 1) = NewArr(nRow, nCol)
      Next nCol
  Next nRow

@SArthur · 07.01.2010, 13:01 **[ТС]**

СПАСИБО !!!!!!!!!!!!!!!!!!!!!!!!!!

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .	Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»	SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .

@SArthur 0 / 0 / 0 Регистрация: 03.01.2010 Сообщений: 6

	Фильтрация двумерного массива 03.01.2010, 01:21. Показов 6569. Ответов 10 Метки нет (Все метки) В общем ситуация следующая: я создал двумерный массив состоящий из рэндомных чисел (размерность массива и диапазон чисел задаю с клавиатуры), после чего отфильтровал его по заданному условию и обнулил все те значения которые не подходили по условиям фильтра. В результате получил тот же массив но с нулями на тех местах где раньше стояли значения не подходящие под условия фильтра. Уважаемые знатоки! Внимание, вопрос! - как из получившегося массива сделать двумерный массив но другой размерности (размерность нужно задать с клавиатуры) так чтобы исчезли все нули, а на их место стали другие числа из массива ? Заранее благодарю всех тех кто хоть как-то поможет мне в решении это не легкой для меня задачи =)) Спасибо 0

@yaser 134 / 79 / 6 Регистрация: 06.04.2009 Сообщений: 192
	03.01.2010, 08:16
	А какие другие числа? И какой другой размерности? А если в какой-либо строке нулей больше, чем в остальных? И, вообще, желательно образец выложить сюда. 0

@SArthur 0 / 0 / 0 Регистрация: 03.01.2010 Сообщений: 6
	04.01.2010, 13:03 [ТС]
	Огромное спасибо за переработку кода!!! =) Вот впринципе само задание которое нужно сделать: 1. Сформировать на листе Excel матрицу случайных чисел X, распределенных равномерно в диапазоне [A1;A2]. Значения A1 и A2 задаются с клавиатуры. 2. Провести фильтрацию полученных чисел X. Вид фильтрации: X не пренадлежит [max/5;max/2]. 3. Заполнить квадратную матрицу размерностью k числами, полученными после фильтрации. Размерность k вводится с клавиатуры. Как видно, первые два пункта я с горем пополам написал и Вы мне поправили. Вся загвоздка в третьем пункте. Насколько я понимаю там не важно сколько значений будет получено, ведь датчик не нулевых значений у нас уже написан и он выдает их количество. Исходя из этого количества можно расчитать квадратную матрицу (например если не нулевых значений получилось 13, то ближайшая квадратная матрица 4x4 - 16 значений, так как у нас только 13 то оставшиеся последние ячейки нужно заполнить тупо нолями) и построить ее. 0

@SArthur 0 / 0 / 0 Регистрация: 03.01.2010 Сообщений: 6
	05.01.2010, 08:11 [ТС]
	И еще раз Огромнейшее спасибо Вам за помощь !!!! Только я не понял один момент, а где ввод размерности k с клавиатуры ? =) 0

@SArthur 0 / 0 / 0 Регистрация: 03.01.2010 Сообщений: 6
	07.01.2010, 13:01 [ТС]
	СПАСИБО !!!!!!!!!!!!!!!!!!!!!!!!!! 0