Получить из одного одномерного массива другой - VB

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

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

Дана последовательность Massiv. Получить все элементы, входящие в Massiv: а) по одному разу (Massiv1) б) более чем по одному разу (Massiv2) в) более чем по два раза (Massiv3) Попыталась сделать пункт А. Половину элементов в Massiv1 заносит правильно, а потом начинает выводить туда те элементы, которые не соответствуют условию отбора.=( Про пункт Б и В вообще лучше промолчу - запуталась окончательно. Помогите, пожалуйста.

Решение задачи: «Получить из одного одномерного массива другой»

textual
Листинг программы
Sub m_1()
Dim myArray(1 To 10) As Single
Dim myArray_1() As Single
Dim myArray_2() As Single
Dim myArray_3() As Single
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim vКоличество As Integer
ReDim myArray_1(1 To 10)
ReDim myArray_2(1 To 10)
ReDim myArray_3(1 To 10)
For i = LBound(myArray) To UBound(myArray)
    myArray(i) = Cells(i, 1)
Next i
For i = LBound(myArray) To UBound(myArray)
    vКоличество = 0
    For j = LBound(myArray) To UBound(myArray)
        If myArray(i) = myArray(j) Then
            vКоличество = vКоличество + 1
        End If
    Next j
    Select Case vКоличество
        Case 1
            k = k + 1
            myArray_1(k) = myArray(i)
        Case 2
            l = l + 1
            myArray_2(l) = myArray(i)
        Case Else
            l = l + 1
            m = m + 1
            myArray_2(l) = myArray(i)
            myArray_3(m) = myArray(i)
    End Select
Next i
If k <> 0 Then
    ReDim Preserve myArray_1(1 To k)
End If
If l <> 0 Then
    ReDim Preserve myArray_2(1 To l)
End If
If m <> 0 Then
    ReDim Preserve myArray_3(1 To m)
End If
For i = LBound(myArray_1) To UBound(myArray_1)
    Cells(i, 2) = myArray_1(i)
Next i
For i = LBound(myArray_2) To UBound(myArray_2)
    Cells(i, 3) = myArray_2(i)
Next i
For i = LBound(myArray_3) To UBound(myArray_3)
    Cells(i, 4) = myArray_3(i)
Next i
End Sub

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


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

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

15   голосов , оценка 3.467 из 5
Похожие ответы