Основы работы в VBA. Массивы

3. Создание новых массивов при решении задач

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

Пример 1. Дан вещественный массив А(n). Вывести отдельно массив целых положительных чисел (если они есть в исходном массиве) и массив оставшихся.

Решение. Для фиксации текущих  значений индексов в новых массивах введем счетчик k для массива B и счетчик q  для массива D. При нахождении элементов массива соответствующих  первому условию задачи увеличим значение k на единицу и присвоим этот индекс элементу нового массива  B и т.п. Аналогичная процедура повторяется и при выполнении  второго условия задачи, где формируется еще  один массив D.

 Sub task_1()

Dim A(10), B(10), D(10) As Single

Dim k As Byte, q As Byte, i As Byte

'ввод массива

For i = 1 To 10

A(i) = Cells(1, i)

Next i

'обнуление счетчиков новых массивов

k = 0: q = 0

For i = 1 To 10

'определение целого положительного числа

If (A(i) - Int(A(i))) = 0 And A(i) >= 0 Then

'вычисление текущего индекса массива В и запись числа в массив В

k = k + 1

B(k) = A(i)

Else

'запись элемента А(i) в новый массив D

q = q + 1

D(q) = A(i)

End If

Next i

If k = 0 Then

Cells(3, 1) = "В массиве целых чисел нет"

Else

Cells(3, 1) = "Массив целых положительных чисел B:"

For i = 1 To k

Cells(4, i) = B(i)

Next i

End If

If q = 0 Then

Cells(5, 1) = "Массив состоит только из целых положительных чисел"

Else

Cells(5, 1) = "Массив оставшихся чисел  D:"

For i = 1 To q

Cells(6, i) = D(i)

Next i

End If

End Sub

 

Результат выполнения программы:

Пример 2. Ввести массив А(n). Разделить его на два массива. Первый из элементов А(n) с четными индексами, второй – с нечетными. Вывести на печать исходный и вновь образованный массивы.

 Sub task_2()

Randomize Timer

Dim i As Integer, n As Integer, k_chetn As Integer

Dim k_nechet As Integer

Dim str1 As String, str2 As String, str3 As String

Dim a() As Single, b() As Single, c() As Single

n = InputBox("Введите размер массива", "Запрос 1 из 1")

ReDim a(n): ReDim b(CInt(n / 2)): ReDim c(CInt(n / 2))

str1 = "": str2 = "": str3 = ""

'заполнение исходного массива случайными числами

For i = 1 To n

a(i) = Int(Rnd() * 100)

str1 = str1 & a(i) & Chr(9)

Next i

'обнуление счетчиков

k_chet = 0: k_nechet = 0

'разделение исходного массива

For i = 1 To n

'определение четности индекса

If i / 2 = i \ 2 Then

'запись элементов с четными индексами в массив b

k_chet = k_chet + 1

b(k_chet) = a(i)

str2 = str2 & b(k_chet) & Chr(9)

Else

'запись элементов с нечетными индексами в массив с

k_nechet = k_nechet + 1

c(k_nechet) = a(i)

str3 = str3 & c(k_nechet) & Chr(9)

End If

Next i

'Команда MsgBox... записывается в редакторе VB в одну строку

MsgBox "Исходный массив:" & Chr(13) & str1 & Chr(13) & Chr(13) & "Массив с четными индексами:" & Chr(13) & str2 & Chr(13) & Chr(13) & "Массив с нечетными индексами:" & Chr(13) & str3

End Sub

 

Результат выполнения программы:

 

Пример . Ввести массив А(n). Разделить его на два массива. Первый из четных элементов А(n), второй – из нечетных. Вывести на печать исходный и вновь образованный массивы.

 Sub task_3()

Randomize Timer

Dim i As Integer, n As Integer, k_chetn As Integer

Dim k_nechet As Integer

Dim str1 As String, str2 As String, str3 As String

Dim a() As Single, b() As Single, c() As Single

n = InputBox("Введите размер массива", "Запрос 1 из 1")

ReDim a(n): ReDim b(n): ReDim c(n)

str1 = " ": str2 = " ": str3 = " "

'заполнение исходного массива случайными числами

For i = 1 To n

a(i) = Int(Rnd() * 100)

str1 = str1 & a(i) & Chr(9)

Next i

'обнуление счетчиков

k_chet = 0: k_nechet = 0

'разделение исходного массива

For i = 1 To n

'определение четности элемента

If a(i) / 2 = a(i) \ 2 Then

'запись элементов с четными индексами в массив b

k_chet = k_chet + 1

b(k_chet) = a(i)

str2 = str2 & b(k_chet) & Chr(9)

Else

'запись элементов с нечетными индексами в массив с

k_nechet = k_nechet + 1

c(k_nechet) = a(i)

str3 = str3 & c(k_nechet) & Chr(9)

End If

Next i

'Команда MsgBox... записывается в редакторе VB в одну строку

MsgBox "Исходный массив:" & Chr(13) & str1 & Chr(13) & Chr(13) & "Массив с четными индексами:" & Chr(13) & str2 & Chr(13) & Chr(13) & "Массив с нечетными индексами:" & Chr(13) & str3 , , "Ответ"

End Sub

 

Результат выполнения программы: