Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

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

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


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 15 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

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

Здравствуйте. Имеется следующий документ:
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 Кб, 7 просмотров)
Zaris вне форума   Ответить с цитированием
Старый 14.08.2019, 21:44   #2
Aleksandr H.
2 the Nation Glory
Профессионал
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Адрес: Wild West Ukraine
Сообщений: 2,662
Репутация: 1096
По умолчанию

Смотрите udf в файле
Вложения
Тип файла: xls Копия пример.xls (38.0 Кб, 8 просмотров)
__________________
Mailto: media.project@ukr.net
Aleksandr H. на форуме   Ответить с цитированием
Старый 15.08.2019, 10:41   #3
Zaris
Новичок
Джуниор
 
Регистрация: 14.08.2019
Сообщений: 5
Репутация: 10
По умолчанию

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

Цитата:
Сообщение от 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, 13:02   #5
Aleksandr H.
2 the Nation Glory
Профессионал
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Адрес: Wild West Ukraine
Сообщений: 2,662
Репутация: 1096
По умолчанию

Если
Цитата:
немного поменять условие
то надо менять цикл с foreach на for c началом от 2-го элемента и сравнивать ячейки позиций [i] c [i-1]
__________________
Mailto: media.project@ukr.net
Aleksandr H. на форуме   Ответить с цитированием
Старый 15.08.2019, 13:57   #6
Zaris
Новичок
Джуниор
 
Регистрация: 14.08.2019
Сообщений: 5
Репутация: 10
По умолчанию

Цитата:
Сообщение от 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, 14:27   #7
Aleksandr H.
2 the Nation Glory
Профессионал
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Адрес: Wild West Ukraine
Сообщений: 2,662
Репутация: 1096
По умолчанию

Цитата:
Сообщение от Zaris Посмотреть сообщение
В верном направлении думаю?
В верном
Цитата:
Сообщение от Zaris Посмотреть сообщение
Что не так?
Ну так сами и проверьте, сначала вручную как делали это в сообщении 1, а тогда сравните с результатом вашей функции.
__________________
Mailto: media.project@ukr.net
Aleksandr H. на форуме   Ответить с цитированием
Старый 15.08.2019, 14:40   #8
Zaris
Новичок
Джуниор
 
Регистрация: 14.08.2019
Сообщений: 5
Репутация: 10
По умолчанию

Цитата:
Сообщение от 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 вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

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


14:15.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.