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

Вход

Регистрация

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

 

= Мир MS Excel/Удаление наибольшего и наименьшего значения - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление наибольшего и наименьшего значения (Макросы/Sub)
Удаление наибольшего и наименьшего значения
lebensvoll Дата: Понедельник, 04.04.2016, 18:46 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
Добрый вечер уважаемые форумчане!!!
Сложная для меня задача ((((( просто жесть. Сидел смотрел как эти макросы пишутся. Решил рискнуть а вдруг получится (после просмотренных видео уроков соответственно). Потому как понимаю МАКРОС это просто СУПЕРСКАЯ ВЕЩЬ и ее то-ж нужно знать хоть чуток как и эксель.
Пожалуйста посмотрите мой файл. Я походу что то накосячил (((( потому как не пойму чет он не работает.
Задумка из прошлых ГОРЯЧИХ ТЕМ %) My WebPage решил дополнить данный файл еще одним макросом
УСЛОВИЕ:
Если в столбце N4>4 и O4>4, то при активации макроса. Он должен найти в столбце D4:M4 самое наибольшее число и удалить, до тех пор пока в ячейке N4<=4. А также самое наименьшее число и удалять, до тех пор пока в ячейке O4<=4.
Что я не так сделал????
[moder]Название темы должно отражать суть вопроса. Переименуйте. Исправлено[/moder]
К сообщению приложен файл: 8824276.xlsm(20Kb)


Кто бы ты ни был, мир в твоих руках

Сообщение отредактировал lebensvoll - Понедельник, 04.04.2016, 19:25
 
Ответить
СообщениеДобрый вечер уважаемые форумчане!!!
Сложная для меня задача ((((( просто жесть. Сидел смотрел как эти макросы пишутся. Решил рискнуть а вдруг получится (после просмотренных видео уроков соответственно). Потому как понимаю МАКРОС это просто СУПЕРСКАЯ ВЕЩЬ и ее то-ж нужно знать хоть чуток как и эксель.
Пожалуйста посмотрите мой файл. Я походу что то накосячил (((( потому как не пойму чет он не работает.
Задумка из прошлых ГОРЯЧИХ ТЕМ %) My WebPage решил дополнить данный файл еще одним макросом
УСЛОВИЕ:
Если в столбце N4>4 и O4>4, то при активации макроса. Он должен найти в столбце D4:M4 самое наибольшее число и удалить, до тех пор пока в ячейке N4<=4. А также самое наименьшее число и удалять, до тех пор пока в ячейке O4<=4.
Что я не так сделал????
[moder]Название темы должно отражать суть вопроса. Переименуйте. Исправлено[/moder]

Автор - lebensvoll
Дата добавления - 04.04.2016 в 18:46
lebensvoll Дата: Понедельник, 04.04.2016, 19:59 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
Модератор, если не занят помоги разобраться что я сделал не так. Макрос прописывал как показывают в видео уроках "Запись макроса". Но почему у меня не получилось то(((((


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеМодератор, если не занят помоги разобраться что я сделал не так. Макрос прописывал как показывают в видео уроках "Запись макроса". Но почему у меня не получилось то(((((

Автор - lebensvoll
Дата добавления - 04.04.2016 в 19:59
Udik Дата: Понедельник, 04.04.2016, 20:09 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1215
Репутация: 153 ±
Замечаний: 0% ±

Excel 2013
Он должен найти в столбце D4:M4

Это не столбец, это диапазон.


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com


Сообщение отредактировал Udik - Понедельник, 04.04.2016, 20:10
 
Ответить
Сообщение
Он должен найти в столбце D4:M4

Это не столбец, это диапазон.

Автор - Udik
Дата добавления - 04.04.2016 в 20:09
al-Ex Дата: Понедельник, 04.04.2016, 20:10 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 148
Репутация: 53 ±
Замечаний: 20% ±

Excel 2010
почему у меня не получилось
Для начала попроще задачки надо брать. Потом одну сложную разбить на ряд простых.
 
Ответить
Сообщение
почему у меня не получилось
Для начала попроще задачки надо брать. Потом одну сложную разбить на ряд простых.

Автор - al-Ex
Дата добавления - 04.04.2016 в 20:10
lebensvoll Дата: Понедельник, 04.04.2016, 20:17 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
Да я вроде не так и сложную то взял. Тем более что включаешь запись макроса и начинаешь выполнять все те действия которые тебе нужны. Я вроде бы так и сделал. Попробовал лишь на на одной строке. Так я понял нужно попытаться этот макрос разбить (т.е переписать) на несколько макросов. Уж лучше пусть будет их несколько но за то правильно. ТАК!!!???


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеДа я вроде не так и сложную то взял. Тем более что включаешь запись макроса и начинаешь выполнять все те действия которые тебе нужны. Я вроде бы так и сделал. Попробовал лишь на на одной строке. Так я понял нужно попытаться этот макрос разбить (т.е переписать) на несколько макросов. Уж лучше пусть будет их несколько но за то правильно. ТАК!!!???

Автор - lebensvoll
Дата добавления - 04.04.2016 в 20:17
al-Ex Дата: Понедельник, 04.04.2016, 20:22 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 148
Репутация: 53 ±
Замечаний: 20% ±

Excel 2010
Ну и конечно, только видеоурока "маловато будет". Нужно будет какую нибудь книжечку полистать, для начала, там-же и примеры простые присмотреть. Простая запись макрорекордера - это полуфабрикат а не макрос.
Так-же как обрезки курицы от котлеты по киевски, отличаются.


Сообщение отредактировал al-Ex - Понедельник, 04.04.2016, 22:21
 
Ответить
СообщениеНу и конечно, только видеоурока "маловато будет". Нужно будет какую нибудь книжечку полистать, для начала, там-же и примеры простые присмотреть. Простая запись макрорекордера - это полуфабрикат а не макрос.
Так-же как обрезки курицы от котлеты по киевски, отличаются.

Автор - al-Ex
Дата добавления - 04.04.2016 в 20:22
lebensvoll Дата: Понедельник, 04.04.2016, 20:43 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
(((( самое что интересное на данной странице
Цитата
Нужно будет какую нибудь книжечку полистать
при нажатии скачать книгу (((( ошибка 404 страница не найдена (((( чет там не так походу. Придется искать


Кто бы ты ни был, мир в твоих руках
 
Ответить
Сообщение(((( самое что интересное на данной странице
Цитата
Нужно будет какую нибудь книжечку полистать
при нажатии скачать книгу (((( ошибка 404 страница не найдена (((( чет там не так походу. Придется искать

Автор - lebensvoll
Дата добавления - 04.04.2016 в 20:43
al-Ex Дата: Понедельник, 04.04.2016, 20:57 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 148
Репутация: 53 ±
Замечаний: 20% ±

Excel 2010
ошибка 404
вот это Cсылка рабочяя, а вот тут файлы - примеры из этой книги


Сообщение отредактировал al-Ex - Понедельник, 04.04.2016, 21:14
 
Ответить
Сообщение
ошибка 404
вот это Cсылка рабочяя, а вот тут файлы - примеры из этой книги

Автор - al-Ex
Дата добавления - 04.04.2016 в 20:57
Udik Дата: Понедельник, 04.04.2016, 21:32 | Сообщение № 9
Группа: Друзья
Ранг: Старожил
Сообщений: 1215
Репутация: 153 ±
Замечаний: 0% ±

Excel 2013
Если правильно понял задание
[vba]
Код

Public Sub check1()
    Dim rng1 As Range, unoCell As Range
    Dim maxV(1 To 3) As Long
    
    With Worksheets("Лист1")
        If rng1 Is Nothing Then Set rng1 = .Range("D4:M4")
        i = .Range("N4").Value2
        Do While (i > 4)
            For Each unoCell In rng1
                If unoCell.Value >= maxV(1) Then
                    maxV(1) = unoCell.Value
                    maxV(2) = unoCell.Row
                    maxV(3) = unoCell.Column
                End If
            Next
            .Cells(maxV(2), maxV(3)).Value = ""
            .Range("N4").Select
            Selection.Calculate
            i = .Range("N4").Value2
            maxV(1) = 0
        Loop
        i = .Range("O4").Value2
        maxV(1) = 1000
        Do While (i > 4)
            For Each unoCell In rng1
                If unoCell.Value <= maxV(1) Then
                    maxV(1) = unoCell.Value
                    maxV(2) = unoCell.Row
                    maxV(3) = unoCell.Column
                End If
            Next
            .Cells(maxV(2), maxV(3)).Value = ""
            .Range("O4").Select
            Selection.Calculate
            i = .Range("O4").Value2
            maxV(1) = 1000
        Loop
    End With
End Sub
[/vba]
К сообщению приложен файл: 0t.xlsm(26Kb)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com


Сообщение отредактировал Udik - Понедельник, 04.04.2016, 21:33
 
Ответить
СообщениеЕсли правильно понял задание
[vba]
Код

Public Sub check1()
    Dim rng1 As Range, unoCell As Range
    Dim maxV(1 To 3) As Long
    
    With Worksheets("Лист1")
        If rng1 Is Nothing Then Set rng1 = .Range("D4:M4")
        i = .Range("N4").Value2
        Do While (i > 4)
            For Each unoCell In rng1
                If unoCell.Value >= maxV(1) Then
                    maxV(1) = unoCell.Value
                    maxV(2) = unoCell.Row
                    maxV(3) = unoCell.Column
                End If
            Next
            .Cells(maxV(2), maxV(3)).Value = ""
            .Range("N4").Select
            Selection.Calculate
            i = .Range("N4").Value2
            maxV(1) = 0
        Loop
        i = .Range("O4").Value2
        maxV(1) = 1000
        Do While (i > 4)
            For Each unoCell In rng1
                If unoCell.Value <= maxV(1) Then
                    maxV(1) = unoCell.Value
                    maxV(2) = unoCell.Row
                    maxV(3) = unoCell.Column
                End If
            Next
            .Cells(maxV(2), maxV(3)).Value = ""
            .Range("O4").Select
            Selection.Calculate
            i = .Range("O4").Value2
            maxV(1) = 1000
        Loop
    End With
End Sub
[/vba]

Автор - Udik
Дата добавления - 04.04.2016 в 21:32
al-Ex Дата: Понедельник, 04.04.2016, 21:51 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 148
Репутация: 53 ±
Замечаний: 20% ±

Excel 2010
Раз уж человек сам решил написать макрос, я не стал делать полностью решение за него.
Вот в коде некий конструктор наскоро набросал:
Две функции,
Одна находит максимальное значение в диапазоне, другая минимальное.
и две процедуры с их применением.
Одна удаляет (однократно) максимальное значение из выделенного диапазона, другая минимальное.
Это для начала. Вдруг пригодится.
К сообщению приложен файл: Konstruktor.xlsm(25Kb)


Сообщение отредактировал al-Ex - Вторник, 05.04.2016, 08:22
 
Ответить
СообщениеРаз уж человек сам решил написать макрос, я не стал делать полностью решение за него.
Вот в коде некий конструктор наскоро набросал:
Две функции,
Одна находит максимальное значение в диапазоне, другая минимальное.
и две процедуры с их применением.
Одна удаляет (однократно) максимальное значение из выделенного диапазона, другая минимальное.
Это для начала. Вдруг пригодится.

Автор - al-Ex
Дата добавления - 04.04.2016 в 21:51
_Boroda_ Дата: Понедельник, 04.04.2016, 21:56 | Сообщение № 11
Группа: Модераторы
Ранг: Экселист
Сообщений: 9375
Репутация: 3948 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Ну и я заморочился что-то. Специально писал попроще (но раза в 3-4 подлиннее) и с комментариями.
[vba]
Код

Sub tt()
    Dim d_ As Range 'd - массив ячеек
    Application.ScreenUpdating = 0 'отключаем обновление экрана
    r1_ = Range("D" & Rows.Count).End(xlUp).Row 'последняя заполненная строка в столбце D
    r0_ = 4 'первая строка
    n_ = 10 'кол-во столбцов
    For i = r0_ To r1_ 'цикл по строкам
        Set d_ = Range("D" & i).Resize(, n_) 'говорим, что d будет n ячеек вправо от столбца D i-ой строки
        x1_ = 0
        x2_ = 0
        For j = 1 To n_ ' цикл от одного до n (больше, чем n ячеек удалить просто не получится)
            'блок 1
            If x1_ = 0 Then 'если x1_=0, то
                mx_ = WorksheetFunction.Max(d_) 'ищем максимум по d
                mn_ = WorksheetFunction.Min(d_) 'ищем минимум по d
                On Error Resume Next 'пропускаем ошибку (на случай, если все значения пусты или =0)
                av_ = WorksheetFunction.Average(d_) 'ищем среднее по d
                e1_ = Err.Number ' присваиваем e значение ошибки (для деления на 0 ошибка 1004, иначе - false)
                On Error GoTo 0 'убираем пропуск ошибок
                z1_ = (mx_ - av_ <= 4) + e1_ = 0 'mx_ - av_ <= 4 даст true или false и плюс e
                    'даст 0 тогда, когда уже не нужно удалять лишнее
                If z1_ Then ' если z1 не 0, то
                    n1_ = WorksheetFunction.Match(mx_, d_, 0) 'ПОИСКПОЗом ищем позицию максимума в d
                    Range("D" & i).Offset(, n1_ - 1).ClearContents 'стираем ее
                Else 'если z1 = 0, то
                    x1_ = 1 'присваиваем х1 единицу
                    If x2_ Then 'если при этом и х2 тоже единица, то
                        Exit For 'выход из цикла
                    End If
                End If
            End If
            'блок 2 аналогично блоку 1
            If x2_ = 0 Then
                mn_ = WorksheetFunction.Min(d_)
                On Error Resume Next
                av_ = WorksheetFunction.Average(d_)
                e2_ = Err.Number
                On Error GoTo 0
                z2_ = (av_ - mn_ <= 4) + e2_ = 0
                If z2_ Then
                    n2_ = WorksheetFunction.Match(mn_, d_, 0)
                    Range("D" & i).Offset(, n2_ - 1).ClearContents
                Else
                    x2_ = 1
                    If x1_ Then
                        Exit For
                    End If
                End If
            End If
        Next j
    Next i
End Sub
[/vba]
К сообщению приложен файл: 8824276_2.xlsm(23Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеНу и я заморочился что-то. Специально писал попроще (но раза в 3-4 подлиннее) и с комментариями.
[vba]
Код

Sub tt()
    Dim d_ As Range 'd - массив ячеек
    Application.ScreenUpdating = 0 'отключаем обновление экрана
    r1_ = Range("D" & Rows.Count).End(xlUp).Row 'последняя заполненная строка в столбце D
    r0_ = 4 'первая строка
    n_ = 10 'кол-во столбцов
    For i = r0_ To r1_ 'цикл по строкам
        Set d_ = Range("D" & i).Resize(, n_) 'говорим, что d будет n ячеек вправо от столбца D i-ой строки
        x1_ = 0
        x2_ = 0
        For j = 1 To n_ ' цикл от одного до n (больше, чем n ячеек удалить просто не получится)
            'блок 1
            If x1_ = 0 Then 'если x1_=0, то
                mx_ = WorksheetFunction.Max(d_) 'ищем максимум по d
                mn_ = WorksheetFunction.Min(d_) 'ищем минимум по d
                On Error Resume Next 'пропускаем ошибку (на случай, если все значения пусты или =0)
                av_ = WorksheetFunction.Average(d_) 'ищем среднее по d
                e1_ = Err.Number ' присваиваем e значение ошибки (для деления на 0 ошибка 1004, иначе - false)
                On Error GoTo 0 'убираем пропуск ошибок
                z1_ = (mx_ - av_ <= 4) + e1_ = 0 'mx_ - av_ <= 4 даст true или false и плюс e
                    'даст 0 тогда, когда уже не нужно удалять лишнее
                If z1_ Then ' если z1 не 0, то
                    n1_ = WorksheetFunction.Match(mx_, d_, 0) 'ПОИСКПОЗом ищем позицию максимума в d
                    Range("D" & i).Offset(, n1_ - 1).ClearContents 'стираем ее
                Else 'если z1 = 0, то
                    x1_ = 1 'присваиваем х1 единицу
                    If x2_ Then 'если при этом и х2 тоже единица, то
                        Exit For 'выход из цикла
                    End If
                End If
            End If
            'блок 2 аналогично блоку 1
            If x2_ = 0 Then
                mn_ = WorksheetFunction.Min(d_)
                On Error Resume Next
                av_ = WorksheetFunction.Average(d_)
                e2_ = Err.Number
                On Error GoTo 0
                z2_ = (av_ - mn_ <= 4) + e2_ = 0
                If z2_ Then
                    n2_ = WorksheetFunction.Match(mn_, d_, 0)
                    Range("D" & i).Offset(, n2_ - 1).ClearContents
                Else
                    x2_ = 1
                    If x1_ Then
                        Exit For
                    End If
                End If
            End If
        Next j
    Next i
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 04.04.2016 в 21:56
al-Ex Дата: Понедельник, 04.04.2016, 22:05 | Сообщение № 12
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 148
Репутация: 53 ±
Замечаний: 20% ±

Excel 2010
Специально писал попроще
Да-уж, воистину - "попроще" ))).
[vba]
Код
 mx_ = WorksheetFunction.Max(d_) 'ищем максимум по d
[/vba]
а вот это, да. Класс, я просто не знал что есть такие.


Сообщение отредактировал al-Ex - Понедельник, 04.04.2016, 22:15
 
Ответить
Сообщение
Специально писал попроще
Да-уж, воистину - "попроще" ))).
[vba]
Код
 mx_ = WorksheetFunction.Max(d_) 'ищем максимум по d
[/vba]
а вот это, да. Класс, я просто не знал что есть такие.

Автор - al-Ex
Дата добавления - 04.04.2016 в 22:05
lebensvoll Дата: Понедельник, 04.04.2016, 23:06 | Сообщение № 13
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
как завязать активацию кнопки и действия макроса :'( ???? А также как удалять :'( [vba]
Код
Intersect(Rows(i), Range("U:U,AL:AM,AS:as,AV:AX")).ClearContents
[/vba] понимаю что это является удалением но как его применить ((((( ААААААААА.
Посмотрите вложение пожалуйста
К сообщению приложен файл: 6325604.xlsm(22Kb)


Кто бы ты ни был, мир в твоих руках
 
Ответить
Сообщениекак завязать активацию кнопки и действия макроса :'( ???? А также как удалять :'( [vba]
Код
Intersect(Rows(i), Range("U:U,AL:AM,AS:as,AV:AX")).ClearContents
[/vba] понимаю что это является удалением но как его применить ((((( ААААААААА.
Посмотрите вложение пожалуйста

Автор - lebensvoll
Дата добавления - 04.04.2016 в 23:06
lebensvoll Дата: Понедельник, 04.04.2016, 23:13 | Сообщение № 14
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
Блин а я и так и этак (((( а вы уже и ответы выложили ))))) ну вы ПРОСТО ГЕНИИИ я только начал понимать. Сначала разбил на группы данный макрос. Понял как это делается (но напрямую прописывать ЭТО БЯДА, поэтому пользуюсь ЗАПИСЬ МАКРОСА - ПРИМИТИВ но сам!!!). И не смог завязать кнопку ((((( ну ни как. Затем задумался за удаление значения (((( это воообще прям мозги потекли ((((( уффффф. Еще раз ТЫСЯЧУ БЛАГОДАРНОСТЕЙ ВАМ. Но я буду стараться я вам обещаю. За книжки спасибо буду читать. И ЧЕ Я В ШКОЛЕ НЕ УЧИЛСЯ :'(


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеБлин а я и так и этак (((( а вы уже и ответы выложили ))))) ну вы ПРОСТО ГЕНИИИ я только начал понимать. Сначала разбил на группы данный макрос. Понял как это делается (но напрямую прописывать ЭТО БЯДА, поэтому пользуюсь ЗАПИСЬ МАКРОСА - ПРИМИТИВ но сам!!!). И не смог завязать кнопку ((((( ну ни как. Затем задумался за удаление значения (((( это воообще прям мозги потекли ((((( уффффф. Еще раз ТЫСЯЧУ БЛАГОДАРНОСТЕЙ ВАМ. Но я буду стараться я вам обещаю. За книжки спасибо буду читать. И ЧЕ Я В ШКОЛЕ НЕ УЧИЛСЯ :'(

Автор - lebensvoll
Дата добавления - 04.04.2016 в 23:13
al-Ex Дата: Понедельник, 04.04.2016, 23:17 | Сообщение № 15
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 148
Репутация: 53 ±
Замечаний: 20% ±

Excel 2010
как завязать активацию кнопки... А также как удалять
это уже другая тема, даже две.
 
Ответить
Сообщение
как завязать активацию кнопки... А также как удалять
это уже другая тема, даже две.

Автор - al-Ex
Дата добавления - 04.04.2016 в 23:17
lebensvoll Дата: Понедельник, 04.04.2016, 23:19 | Сообщение № 16
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
да я понял )))) спасибо!!! Всем спокойной ночи, утро вечера мудренее. Завтра обязательно загляну к вам в гости....


Кто бы ты ни был, мир в твоих руках
 
Ответить
Сообщениеда я понял )))) спасибо!!! Всем спокойной ночи, утро вечера мудренее. Завтра обязательно загляну к вам в гости....

Автор - lebensvoll
Дата добавления - 04.04.2016 в 23:19
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление наибольшего и наименьшего значения (Макросы/Sub)
Страница 1 из 11
Поиск:

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