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

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

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

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

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 14.08.2019, 13:30   #1
Zaris
 
Регистрация: 14.08.2019
Сообщений: 8
По умолчанию Макрос для применения формулы к каждому столбцу последовательно

Здравствуйте. Имеется следующий документ:
http://prntscr.com/oshwa7
В 16 столбце я пишу формулу:
=ЕСЛИ(RC[-10]>RC[-13]+1000;RC[-10];0)
и протягиваю эту формулу на все строки
(если цена с доставкой 1 больше чем наша цена + 1000, то берем эту цену, а иначе 0). 0 здесь всего лишь метка, по которой мы фильтруем данный столбец и переходим к следующему.
Видно, на первом шаге нашему условию удовлетворяет только 1 позиция:
http://prntscr.com/oshyfh
После этого шага я фильтрую 16 столбец по значению 0 и пишу эту же формулу для цены с доставкой 2
=ЕСЛИ(RC[-9]>RC[-13]+1000;RC[-9];0)
и снова протягиваю эту формулу на все строки
На втором шаге позиций уже больше
http://prntscr.com/osieno
Единственная позиция от первого шага осталась с ценой доставкой 1, несмотря на то что и под условие с ценой доставкой 2 тоже попадает (но в формулу 2 шага она не попала, т.к заранее отфильтровали по значению "0")
После этого шага я фильтрую 16 столбец по значению 0 и пишу эту же формулу для цены с доставкой 3
И так я повторяю эту формулу для всех столбцов, пока формула не примет такой вид:
=ЕСЛИ(RC[-1]>RC[-13]+1000;RC[-1];0)
После этого шага я фильтрую 16 столбец по значению 0 и, т.к столбцы закончились а эти позиции под наше условие так и не попали, мы их удаляем.
В моем случае таких позиций не было, поэтому ничего не удалялось.
В итоге получился такой документ: (см. вложения)
Можно ли для этой ситуации написать макрос для автоматизации (столбцов может быть бесконечно много). Что изучить? Спасибо
Вложения
Тип файла: xlsx пример.xlsx (11.2 Кб, 14 просмотров)
Zaris вне форума Ответить с цитированием
Старый 14.08.2019, 20:44   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Смотрите udf в файле
Вложения
Тип файла: xls Копия пример.xls (38.0 Кб, 17 просмотров)
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 15.08.2019, 09:41   #3
Zaris
 
Регистрация: 14.08.2019
Сообщений: 8
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
Смотрите udf в файле
то, что нужно, спасибо большое
Zaris вне форума Ответить с цитированием
Старый 15.08.2019, 10:25   #4
Zaris
 
Регистрация: 14.08.2019
Сообщений: 8
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
Смотрите udf в файле
Александр, а как поменяется код если немного поменять условие с этого:
(старт) =ЕСЛИ(RC[-10]>RC[-13]+1000;RC[-10];0)
(финиш) =ЕСЛИ(RC[-1]>RC[-13]+1000;RC[-1];0)
на это:
(старт) =ЕСЛИ((RC[-10]+RC[-9])/2>(RC[-13]+1000);(RC[-10]+RC[-9])/2;0)
(финиш) =ЕСЛИ((RC[-2]+RC[-1])/2>(RC[-13]+1000);(RC[-2]+RC[-1])/2;0)
Код:
Option Explicit
Function ВторойПризнак(OurPrice As Range, DeliveryPricesRange As Range)
    Dim cel As Range
    For Each cel In DeliveryPricesRange
        If CDbl(OurPrice.Value) + 1000 < (cel.Value + Next cel.value)/2 Then //что-то типо такого?
            Exit For
        End If
    Next cel
    ВторойПризнак = CDbl((cel.Value + Next cel.value)/2)
End Function
Zaris вне форума Ответить с цитированием
Старый 15.08.2019, 12:02   #5
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Если
Цитата:
немного поменять условие
то надо менять цикл с foreach на for c началом от 2-го элемента и сравнивать ячейки позиций [i] c [i-1]
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 15.08.2019, 12:57   #6
Zaris
 
Регистрация: 14.08.2019
Сообщений: 8
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
Если то надо менять цикл с foreach на for c началом от 2-го элемента и сравнивать ячейки позиций [i] c [i-1]
Код:
Option Explicit
Function ÏåðâûéÎäèííàäöàòûéÏðèçíàê(OurPrice As Range, DeliveryPricesRange As Range)
    Dim cel As Range
    For Index = 0 To DeliveryPricesRange.GetUpperBound(0)
        If CDbl(OurPrice.Value) + 1000 < (DeliveryPricesRange(Index).Value + DeliveryPricesRange(Index + 1).Value) / 2 Then
            Exit For
        End If
    Next cel
    ÏåðâûéÎäèííàäöàòûéÏðèçíàê = CDbl((DeliveryPricesRange(Index).Value + DeliveryPricesRange(Index + 1).Value) / 2)
End Function
В верном направлении думаю? Что не так? я с VBA незнаком совсем(
Zaris вне форума Ответить с цитированием
Старый 15.08.2019, 13:27   #7
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Цитата:
Сообщение от Zaris Посмотреть сообщение
В верном направлении думаю?
В верном
Цитата:
Сообщение от Zaris Посмотреть сообщение
Что не так?
Ну так сами и проверьте, сначала вручную как делали это в сообщении 1, а тогда сравните с результатом вашей функции.
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 15.08.2019, 13:40   #8
Zaris
 
Регистрация: 14.08.2019
Сообщений: 8
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
В верном Ну так сами и проверьте, сначала вручную как делали это в сообщении 1, а тогда сравните с результатом вашей функции.
Код:
Option Explicit
Function ÏåðâûéÎäèííàäöàòûéÏðèçíàê(OurPrice As Range, DeliveryPricesRange As Range)
    Dim cel As Range
    Dim Index As Integer
    
    For Index = 0 To DeliveryPricesRange.GetUpperBound(0)
        If CDbl(OurPrice.Value) + 1000 < DeliveryPricesRange(Index).Value Then
            Exit For
        End If
    Next
    ÏåðâûéÎäèííàäöàòûéÏðèçíàê = CDbl(DeliveryPricesRange(Index).Value)
End Function
Для начала я попробовал переписать код из первого примера с For each на For, результат должен быть 1 в 1.
Но у меня не работает, что здесь не так?
Zaris вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Запись формулы в макрос Aleksei_Biboranov Microsoft Office Excel 0 16.07.2019 15:16
Макрос протягивания формулы perven1 Microsoft Office Excel 4 03.10.2017 19:41
Макрос, дописать текст в диапазоне ячеек по столбцу! mostApi Microsoft Office Excel 4 05.10.2015 17:51
Макрос для подстановка искомого текста из одной ячейки в другую по столбцу tonpok666 Microsoft Office Excel 4 07.02.2013 09:33
Макрос присваивает каждому диапазону 1-ый элемент DJTreeno Microsoft Office Excel 3 24.09.2011 17:25