Поиск минимального значения и замена

[Artem_85]

Всем добрый день!

Помогите реализовать следующее.

В столбце А название продуктов, в столбце D цена за штуку на этот продукт, нужно найти минимальную цену за каждый продукт и что бы все цены на этот продукт поменялись на минимальную.

Заранее блогадарю)

[Artem_85]

Ну неужели никто не знает как решить эту задачку?(

[Artem_85]

Может быть сейчас кто нибудь подскажет?
Добавил Столбец G, в него вписал формулу
{=МИН(ЕСЛИ(C$2:C$999998=C$2;F$2:F$9 99998))}

только вот в для каждого наименования надо менять аргумент(С$2), как сделать что бы просто протинуть формулу?......на отдельном листе есть список наименованиия....незнаю может быть пригодится)

[ikki_pf]

$C2
(файл не открывал)

[Artem_85]

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

$C2
(файл не открывал)

ты не понял

[Artem_85]

если я что то не понтяно объясняю Вы скажите..)))

[Artem_85]

............

[Скрипт]

С использованием макросов.

Sub Procedure_1()
    
    'Здесь нужно указать номер строки, с которой
    'начинаются данные.
    Const myStart As Long = 4
    
    Dim myA() As Variant, myD() As Variant, myArray() As Variant
    Dim myLastRow As Long
    Dim shSheet As Excel.Worksheet
    Dim myMin As Double
    Dim i As Long, j As Long, k As Long
    
    '1. Для удобства написания кода даём имя листу,
    'с которым будем работать. Через это имя будем воздействовать на лист.
    Set shSheet = ActiveSheet
    
    '2. Определяем, где заканчиваются данные в столбце "A",
        'чтобы знать, до какой строки обрабатывать данные.
    'What:="?" - знак вопроса - это специальный символ.
    'SearchDirection:=xlPrevious - поиск с конца в начало.
    'В команде "Find" нужно указывать все параметры, т.к.
        'команда "Find" связана с диалоговым окном "Найти и заменить".
        'И установки окна "Найти и заменить" могут повлиять на работу
        'команды "Find".
    myLastRow = shSheet.Columns("A").Find(What:="?", LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
        MatchCase:=False, SearchFormat:=False).Row

    '3. Код быстрее работает с переменными и массивами, чем с объектами.
    'Ячейки на листе Excel являются объектами.
    'Поэтому помещаем данные из ячеек в массивы.
    myA() = shSheet.Range("A" & myStart & ":A" & myLastRow).Value
    myD() = shSheet.Range("D" & myStart & ":D" & myLastRow).Value
    
    '4. В цикле с "i" двигаемся по массиву "myA".
    'UBound(myA, 1) - это порядковый номер последней строки в массиве "myA".
    '"- 1", т.к. последний товар не с чём сравнивать.
    For i = 1 To UBound(myA, 1) - 1 Step 1
    
        'Пустые ячейки пропускаем.
        If myA(i, 1) = Empty Then
            'Переход к следующему наименованию.
            GoTo metka
        End If
    
        '4.1. В массив "myArray" будем запоминать повторяющиеся наименования,
            'чтобы потом в них цены поменять.
        'Каждый раз будем создавать в массиве "myArray"
            'строки, чтобы очищать массив от прежних данных.
        ReDim myArray(1 To UBound(myA, 1))
        
        '4.2. Сразу помещаем в массив "myArray" порядковый номер
            'первого элемента, чтобы было удобнее писать код.
        myArray(1) = i
        
        '4.3. Подготавливаем переменную "k" к использованию.
        'Переменная "k" - это порядковый номер элемента в массиве "myArray".
        '2 - потому что первый элемент уже есть в массиве "myArray".
        k = 2
            
        '4.4. Сначала за минимальную цену принимаем первую цену.
        'Затем, если встретится цена меньше, то за минимальную
        'цену примем уже новую цену.
        myMin = myD(i, 1)
        
        '4.5. В цикле с "j" просматриваем массив "myA", но уже
        'не с начала, а с текущего элемента и плюс один.
        For j = i + 1 To UBound(myA, 1) Step 1
        
            'Если наименования совпадают.
            If myA(i, 1) = myA(j, 1) Then
            
                '4.5.1. Запоминаем номер строки, чтобы потом цену там поменять.
                myArray(k) = j
                
                '4.5.2. Подготавливаем переменную "k" к следующему использованию.
                k = k + 1
                
                '4.5.3. Смотрим цену товара.
                If myD(j, 1) < myMin Then
                    'Помещаем в переменную "myMin" новую цену.
                    myMin = myD(j, 1)
                End If
                
                '4.5.4. Удаляем из массива "myA" наименование,
                'т.к. данный товар уже обработан.
                myA(j, 1) = Empty
                
            End If
        Next j
        
        '4.6. Разносим минимальную цену по данному товару.
        'Сначала смотрим, были ли вообще повторения.
        'Если не было повторений, то во втором элементе массива "myArray"
        'не будет нуля.
        If myArray(2) <> 0 Then
            'Подготавливаем переменную "j" к другому использованию.
            j = 1
            Do
                myD(myArray(j), 1) = myMin
                j = j + 1
            Loop While myArray(j) <> 0
        End If
metka:
        
    Next i
    
    '5. Вставляем данные из массива "myD" в столбец "D".
    shSheet.Range("D" & myStart & ":D" & myLastRow) = myD()
    
    '6. Сообщение, что работа кода завершена.
    MsgBox "Работа кода завершена!", vbInformation
    
End Sub

[Скрипт]

Примечания

1. Обратите внимание на округление чисел в Excel. В ячейке на мониторе может отображаться одно число, а на самом деле в ячейке находится другое число.
2. Для ускорения работы кода можно сделать следующее на время работы кода:
   1. отключить обновление монитора;
   2. отключить обработку событий;
   3. отключить пересчёт формул.

       'Отключение.
       'Обновление монитора.
       Application.ScreenUpdating = False
       'События.
       Application.EnableEvents = False
       'Пересчёт формул.
       Application.Calculation = xlCalculationManual
       
       'Включение.
       Application.ScreenUpdating = True
       Application.EnableEvents = True
       Application.Calculation = xlCalculationAutomatic

[ikki_pf]

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

если я что то не понтяно объясняю Вы скажите..)))

мне непонятно - на каком из форумов ВАМ отвечать?