Задача с массивом (VBA)

[mad_moon]

В произвольном массиве E из n элементов найти наименьший элемент и записать его на первое место нового масива, а затем дописать в новый массив элементы, значение которых не меньше заданной константы (E >= const)

Начальные данные, что необходимо ввести, следует предварительно записать в избранные ячейки листа MS Excel и оттуда ввести их в программу. Выведение данных осуществить в другие ячейки листа.

Массив ввела, минимальное нашла, а вот дальше - ступор((

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

Заранее спасибо!

То что у меня получилось:

Sub Rabota()
Dim i As Integer, A() As Integer, n As Integer, r As Integer
Dim min As Single
r = Val(InputBox("Введите номер ячейки", "Окно ввода", "1"))
n = Val(InputBox("Введите размерность массива"))
ReDim A(n)
For i = 1 To n
A(i) = Cells(r, 1)
r = r + 1
Next i
min = 1E+38
For i = 1 To n
If A(i) < min Then min = A(i)
Next i
Debug.Print "min ="; min


End Sub

[SAS888]

Можно так:

Sub Rabota()
    Dim i As Integer, a(), b()
    Const MinValue = 25 'Значение для сравнения элементов массива
    With Application
'Пусть данные для массива находятся в диапазоне ячеек "A1:A10"
'Получим одномерный массив из значений этого диапазона:
        a = .Transpose(.Index([A1:A10].Value, 0, 1))
'Определим массив b из одного элемента и запишем в него минимальное значение иассива a:
        ReDim b(0): b(0) = .min(a)
'Организуем цикл по всем элементам массива a. При выполнении условия, наращиваем массив b:
        For i = LBound(a) To UBound(a)
            If a(i) >= MinValue Then
                ReDim Preserve b(UBound(b) + 1)
                b(UBound(b)) = a(i)
            End If
        Next
'Выведем в столбец "B" полученный мвссив:
        [B1].Resize(UBound(b)).Value = .Transpose(b)
    End With
End Sub

[mad_moon]

спасибо за помощь

может подскажите хороший учебник по VBA? а то не хватает мне знаний(((

заранее благодарствую

[slan]

а зачем все эти транспозы и редимы?

.resize и так запишет только нужные элементы..

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

Sub Rabota()
    Dim i As Long, a, b, mn, mn_i&, x
    Const MinValue = 25 'Значение для сравнения элементов массива
        a = [A1:A10].Value
        ReDim b(1 To UBound(a), 1 To 1)
        
        i = 1: mn = a(1, 1): mn_i = 1
        
        For i = 2 To UBound(a)
            If mn > a(i, 1) Then
                mn = a(i, 1)
                mn_i = i
            End If
        Next
        b(1, 1) = mn
        a(mn_i, 1) = MinValue - 1
        
        i = 1
        For Each x In a
            If x >= MinValue Then
                i = i + 1
                b(i, 1) = x
            End If
        Next
'Выведем в столбец "B" полученный массив:
        [B1].Resize(i) = b
End Sub

[SAS888]

а зачем все эти транспозы и редимы?

Т.к. автор в своем примере использует только одномерные массивы, то я сделал так же.

...если читать по-русски, то...

Пробую читать "по-русски":

найти наименьший элемент и записать его на первое место нового масива, а затем дописать в новый массив элементы, значение которых не меньше заданной константы

вижу две задачи: 1-я - это запись на первое место наименьшего элемента имеющегося массива, причем, не зависимо от его величины; 2-я - дальнейшая запись элементов, удовлетворяющих условию. Дописать - значит увеличить количество элементов массива. Поэтому, после выполнения предложенной мной процедуры, кроме значений на рабочем лисе, мы имеем требуемый одномерный массив без лишних (пустых) элементов.
Нужно ли все это, или нет - решать автору вопроса.

[slan]

чувствую, что заводитесь

не стоит..

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

ну а то, что автор использует одномерные..

а если он код выложит с ошибками, вы же ошибки исправите?

ответ, я считаю, должен быть максимально точным, в первую очередь, и максимально эффективным - во-вторую..

[SAS888]

Скорее имелось ввиду...

Мы с Вами можем думать как угодно.

ну а то, что автор использует одномерные..
а если он код выложит с ошибками, вы же ошибки исправите?

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

ответ, я считаю, должен быть максимально точным, в первую очередь...

Безусловно. Но не зная точной задачи, это сделать невозможно. (см. подпись)

[slan]

вот я, как раз, и даю ему альтернативу

а к алгоритму претензии есть? жду критики..

[SAS888]

а к алгоритму претензии есть? жду критики..

У меня претензий нет. И быть не может. Но, если Вас интересует мое мнение, то для выполнения задачи, можно обойтись и одним циклом. Например, так:

Sub Rabota()
    Dim i As Long, f As Boolean, a, b, x
    Const MinValue = 25 'Значение для сравнения элементов массива
    a = [A1:A10].Value: ReDim b(1 To UBound(a), 1 To 1)
    b(1, 1) = Application.Min(a): i = 1
    For Each x In a
        If x >= MinValue Then
            If x = b(1, 1) Then
                If f Then
                    i = i + 1: b(i, 1) = x
                Else: f = True
                End If
            Else
                i = i + 1: b(i, 1) = x
            End If
        End If
    Next
    [B1].Resize(i) = b
End Sub

[slan]

конечно интересует.

по алгоритму:

первый мой цикл - это тоже самое, что у Вас

b(1, 1) = Application.Min(a)

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

конечно, надо сравнить тупо по скорости.. но щас лень