Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Удалить одинаковые строки, оставить дорогой и дешевый. - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Удалить одинаковые строки, оставить дорогой и дешевый. (Формулы/Formulas)
Удалить одинаковые строки, оставить дорогой и дешевый.
anabioss13 Дата: Четверг, 16.05.2019, 14:29 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 122
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день! Прошу помощи в решении задачи.. Что нужно: В списке есть одинаковые строки по двум столбцам Артикул и Наименование, в основном таких по 2, но встречается по 3 и более. Необходимо найти одинаковые (сразу по обоим столбцам), определить среди одинаковых самую дорогую и самую дешевую цену, в столбец Е присвоить название "Оригинал" дорогому и "Аналог" дешевому, средние значения цены - удалить строки.
К сообщению приложен файл: 0575699.xlsx(12.0 Kb)
 
Ответить
СообщениеДобрый день! Прошу помощи в решении задачи.. Что нужно: В списке есть одинаковые строки по двум столбцам Артикул и Наименование, в основном таких по 2, но встречается по 3 и более. Необходимо найти одинаковые (сразу по обоим столбцам), определить среди одинаковых самую дорогую и самую дешевую цену, в столбец Е присвоить название "Оригинал" дорогому и "Аналог" дешевому, средние значения цены - удалить строки.

Автор - anabioss13
Дата добавления - 16.05.2019 в 14:29
anabioss13 Дата: Пятница, 17.05.2019, 07:01 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 122
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Не возможно это?
 
Ответить
СообщениеНе возможно это?

Автор - anabioss13
Дата добавления - 17.05.2019 в 07:01
skais Дата: Пятница, 17.05.2019, 08:46 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 186
Репутация: 25 ±
Замечаний: 60% ±

Excel 2010
anabioss13, а если будет всего одна строка с артикулом, тогда что?
 
Ответить
Сообщениеanabioss13, а если будет всего одна строка с артикулом, тогда что?

Автор - skais
Дата добавления - 17.05.2019 в 08:46
anabioss13 Дата: Пятница, 17.05.2019, 08:59 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 122
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Оставить ее как есть
 
Ответить
СообщениеОставить ее как есть

Автор - anabioss13
Дата добавления - 17.05.2019 в 08:59
AlexM Дата: Пятница, 17.05.2019, 09:11 | Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3878
Репутация: 976 ±
Замечаний: 0% ±

Excel 2003
в строке 21 амортизатор не такой как в строках 18 и 19, а артикул совпадает. Это ошибка?



Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.
 
Ответить
Сообщениев строке 21 амортизатор не такой как в строках 18 и 19, а артикул совпадает. Это ошибка?

Автор - AlexM
Дата добавления - 17.05.2019 в 09:11
anabioss13 Дата: Пятница, 17.05.2019, 09:18 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 122
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Нет, это не ошибка. Это разные наименования. Т.е. уникальная строка
 
Ответить
СообщениеНет, это не ошибка. Это разные наименования. Т.е. уникальная строка

Автор - anabioss13
Дата добавления - 17.05.2019 в 09:18
AlexM Дата: Пятница, 17.05.2019, 09:20 | Сообщение № 7
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3878
Репутация: 976 ±
Замечаний: 0% ±

Excel 2003
Тогда в строке 18 Оригинал



Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.
 
Ответить
СообщениеТогда в строке 18 Оригинал

Автор - AlexM
Дата добавления - 17.05.2019 в 09:20
skais Дата: Пятница, 17.05.2019, 09:22 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 186
Репутация: 25 ±
Замечаний: 60% ±

Excel 2010
[vba]
Код
Sub Button1_Click()
    arr = Range("B5:K" & Cells(Rows.Count, "B").End(xlUp).Row).Value
    For i = 1 To UBound(arr)
        arr(i, 9) = arr(i, 8)
        arr(i, 10) = arr(i, 8)
        For j = 1 To UBound(arr)
            If arr(i, 2) = arr(j, 2) Then
                If arr(i, 8) < arr(j, 8) Then
                    arr(i, 9) = arr(j, 8)
                ElseIf arr(i, 8) > arr(j, 8) Then
                    arr(i, 10) = arr(j, 8)
                End If
            End If
        Next
    Next

    For i = UBound(arr) To 1 Step -1
        'Cells(i + 4, "J") = arr(i, 9)
        'Cells(i + 4, "K") = arr(i, 10)
        If arr(i, 9) <> arr(i, 10) Then
            If arr(i, 8) = arr(i, 9) Then
                Cells(i + 4, "E") = "Оригинал"
            ElseIf arr(i, 8) = arr(i, 10) Then
                Cells(i + 4, "E") = "Аналог"
            Else
                'Cells(i + 4, "E") = "Удалить"
                Rows(i + 4).Delete
            End If
        End If
    Next
End Sub
[/vba]
К сообщению приложен файл: wwee.xlsm(22.0 Kb)
 
Ответить
Сообщение[vba]
Код
Sub Button1_Click()
    arr = Range("B5:K" & Cells(Rows.Count, "B").End(xlUp).Row).Value
    For i = 1 To UBound(arr)
        arr(i, 9) = arr(i, 8)
        arr(i, 10) = arr(i, 8)
        For j = 1 To UBound(arr)
            If arr(i, 2) = arr(j, 2) Then
                If arr(i, 8) < arr(j, 8) Then
                    arr(i, 9) = arr(j, 8)
                ElseIf arr(i, 8) > arr(j, 8) Then
                    arr(i, 10) = arr(j, 8)
                End If
            End If
        Next
    Next

    For i = UBound(arr) To 1 Step -1
        'Cells(i + 4, "J") = arr(i, 9)
        'Cells(i + 4, "K") = arr(i, 10)
        If arr(i, 9) <> arr(i, 10) Then
            If arr(i, 8) = arr(i, 9) Then
                Cells(i + 4, "E") = "Оригинал"
            ElseIf arr(i, 8) = arr(i, 10) Then
                Cells(i + 4, "E") = "Аналог"
            Else
                'Cells(i + 4, "E") = "Удалить"
                Rows(i + 4).Delete
            End If
        End If
    Next
End Sub
[/vba]

Автор - skais
Дата добавления - 17.05.2019 в 09:22
AlexM Дата: Пятница, 17.05.2019, 09:23 | Сообщение № 9
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3878
Репутация: 976 ±
Замечаний: 0% ±

Excel 2003
Что получилось.
К сообщению приложен файл: 0575699_01.xlsx(12.8 Kb)



Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.
 
Ответить
СообщениеЧто получилось.

Автор - AlexM
Дата добавления - 17.05.2019 в 09:23
anabioss13 Дата: Пятница, 17.05.2019, 10:02 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 122
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
AlexM, Почему-то, когда добавляю данные и протягиваю вашу формулу, предлагает все Удалить..
 
Ответить
СообщениеAlexM, Почему-то, когда добавляю данные и протягиваю вашу формулу, предлагает все Удалить..

Автор - anabioss13
Дата добавления - 17.05.2019 в 10:02
anabioss13 Дата: Пятница, 17.05.2019, 10:03 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 122
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
skais, Я не знаю как использовать ваш вариант на другом файле)) Или добавить в этот больше данных и проверить..) В любом случае спасибо)
 
Ответить
Сообщениеskais, Я не знаю как использовать ваш вариант на другом файле)) Или добавить в этот больше данных и проверить..) В любом случае спасибо)

Автор - anabioss13
Дата добавления - 17.05.2019 в 10:03
skais Дата: Пятница, 17.05.2019, 10:12 | Сообщение № 12
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 186
Репутация: 25 ±
Замечаний: 60% ±

Excel 2010
anabioss13 в этом файле все будет работать при добавлении строк, если не измените струтуру данных.
 
Ответить
Сообщениеanabioss13 в этом файле все будет работать при добавлении строк, если не измените струтуру данных.

Автор - skais
Дата добавления - 17.05.2019 в 10:12
_Boroda_ Дата: Пятница, 17.05.2019, 10:38 | Сообщение № 13
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15578
Репутация: 6075 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
У меня такой вариант
[vba]
Код
Sub tt()
    n_ = Cells(Rows.Count, 2).End(3).Row - 4
    sortir (n_)
    ar = Range("A5").Resize(n_ + 1, 9)
    For i = 1 To n_
        If ar(i, 3) = ar(i + 1, 3) And ar(i, 4) = ar(i + 1, 4) Then 'ниже такая же
            If fl_ Then 'она не первая
                For j = 1 To 9
                    ar(i, j) = Empty
                Next j
            Else 'она первая
                ar(i, 5) = "Оригинал"
            End If
            fl_ = 1
        Else 'ниже другая
            If ar(i, 5) <> "Оригинал" And fl_ Then
                ar(i, 5) = "Аналог"
            End If
            fl_ = 0
        End If
    Next i
    Range("A5").Resize(n_ + 1, 9) = ar
    sortir (n_)
End Sub

Sub sortir(n_)
    With ActiveSheet.Sort.SortFields
        .Clear
        .Add Key:=Range("C5").Resize(n_)
        .Add Key:=Range("D5").Resize(n_)
        .Add Key:=Range("I5").Resize(n_), Order:=xlDescending
        .Parent.SetRange Range("A4").Resize(n_ + 1, 9)
        .Parent.Apply
    End With
End Sub
[/vba]
В свой файл перенести просто - топаете правой мышой на ярлык листа, выбираете "Исходный текст", вставляете туда код и запускаете макрос tt
К сообщению приложен файл: 0575699_1.xlsm(24.1 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеУ меня такой вариант
[vba]
Код
Sub tt()
    n_ = Cells(Rows.Count, 2).End(3).Row - 4
    sortir (n_)
    ar = Range("A5").Resize(n_ + 1, 9)
    For i = 1 To n_
        If ar(i, 3) = ar(i + 1, 3) And ar(i, 4) = ar(i + 1, 4) Then 'ниже такая же
            If fl_ Then 'она не первая
                For j = 1 To 9
                    ar(i, j) = Empty
                Next j
            Else 'она первая
                ar(i, 5) = "Оригинал"
            End If
            fl_ = 1
        Else 'ниже другая
            If ar(i, 5) <> "Оригинал" And fl_ Then
                ar(i, 5) = "Аналог"
            End If
            fl_ = 0
        End If
    Next i
    Range("A5").Resize(n_ + 1, 9) = ar
    sortir (n_)
End Sub

Sub sortir(n_)
    With ActiveSheet.Sort.SortFields
        .Clear
        .Add Key:=Range("C5").Resize(n_)
        .Add Key:=Range("D5").Resize(n_)
        .Add Key:=Range("I5").Resize(n_), Order:=xlDescending
        .Parent.SetRange Range("A4").Resize(n_ + 1, 9)
        .Parent.Apply
    End With
End Sub
[/vba]
В свой файл перенести просто - топаете правой мышой на ярлык листа, выбираете "Исходный текст", вставляете туда код и запускаете макрос tt

Автор - _Boroda_
Дата добавления - 17.05.2019 в 10:38
anabioss13 Дата: Пятница, 17.05.2019, 10:47 | Сообщение № 14
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 122
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Спасибо Всем!
 
Ответить
СообщениеСпасибо Всем!

Автор - anabioss13
Дата добавления - 17.05.2019 в 10:47
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Удалить одинаковые строки, оставить дорогой и дешевый. (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!