Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме 85 тыс рублей в месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 09.01.2013, 12:18   #1
Artem_85
Пользователь
 
Регистрация: 21.02.2012
Сообщений: 82
По умолчанию Поиск минимального значения и замена

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

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

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

Заранее блогадарю)
Вложения
Тип файла: rar Книга2.rar (292.0 Кб, 24 просмотров)
Artem_85 вне форума Ответить с цитированием
Старый 09.01.2013, 13:35   #2
Artem_85
Пользователь
 
Регистрация: 21.02.2012
Сообщений: 82
По умолчанию

Ну неужели никто не знает как решить эту задачку?(
Artem_85 вне форума Ответить с цитированием
Старый 09.01.2013, 14:22   #3
Artem_85
Пользователь
 
Регистрация: 21.02.2012
Сообщений: 82
По умолчанию

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

только вот в для каждого наименования надо менять аргумент(С$2), как сделать что бы просто протинуть формулу?......на отдельном листе есть список наименованиия....незнаю может быть пригодится)
Artem_85 вне форума Ответить с цитированием
Старый 09.01.2013, 14:25   #4
ikki_pf
Форумчанин
 
Регистрация: 25.02.2012
Сообщений: 166
По умолчанию

$C2
(файл не открывал)
ikki_pf вне форума Ответить с цитированием
Старый 09.01.2013, 14:28   #5
Artem_85
Пользователь
 
Регистрация: 21.02.2012
Сообщений: 82
По умолчанию

Цитата:
Сообщение от ikki_pf Посмотреть сообщение
$C2
(файл не открывал)
ты не понял
Artem_85 вне форума Ответить с цитированием
Старый 09.01.2013, 14:29   #6
Artem_85
Пользователь
 
Регистрация: 21.02.2012
Сообщений: 82
По умолчанию

если я что то не понтяно объясняю Вы скажите..)))
Artem_85 вне форума Ответить с цитированием
Старый 09.01.2013, 15:09   #7
Artem_85
Пользователь
 
Регистрация: 21.02.2012
Сообщений: 82
По умолчанию

............
Вложения
Тип файла: rar Книга2.rar (12.3 Кб, 11 просмотров)
Artem_85 вне форума Ответить с цитированием
Старый 09.01.2013, 15:16   #8
Скрипт
Форумчанин
 
Регистрация: 24.12.2012
Сообщений: 906
По умолчанию

С использованием макросов.
Код:
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
Скрипт вне форума Ответить с цитированием
Старый 09.01.2013, 15:17   #9
Скрипт
Форумчанин
 
Регистрация: 24.12.2012
Сообщений: 906
По умолчанию

Примечания
  1. Обратите внимание на округление чисел в Excel. В ячейке на мониторе может отображаться одно число, а на самом деле в ячейке находится другое число.
  2. Для ускорения работы кода можно сделать следующее на время работы кода:
    1. отключить обновление монитора;
    2. отключить обработку событий;
    3. отключить пересчёт формул.
    Код:
        'Отключение.
        'Обновление монитора.
        Application.ScreenUpdating = False
        'События.
        Application.EnableEvents = False
        'Пересчёт формул.
        Application.Calculation = xlCalculationManual
        
        'Включение.
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
Скрипт вне форума Ответить с цитированием
Старый 09.01.2013, 15:23   #10
ikki_pf
Форумчанин
 
Регистрация: 25.02.2012
Сообщений: 166
По умолчанию

Цитата:
Сообщение от Artem_85 Посмотреть сообщение
если я что то не понтяно объясняю Вы скажите..)))
мне непонятно - на каком из форумов ВАМ отвечать?
ikki_pf вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме 85 тыс рублей в месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
замена минимального числа максимальным vovik4385 Общие вопросы C/C++ 0 29.03.2012 18:34
условие минимального значения у bigildar Помощь студентам 2 13.11.2011 17:47
(Псевдо)Рандомный массив и поиск минимального значения в нем Zero&One Помощь студентам 0 30.09.2011 15:39
Поиск максимального и минимального значения в массиве WIN32APIist Общие вопросы C/C++ 5 28.12.2010 00:24
поиск ближайшего минимального значения на sql nuevegramodelamor Помощь студентам 7 11.05.2010 20:21