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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 07.12.2017, 13:18   #1
scumfck
Пользователь
 
Регистрация: 29.05.2017
Сообщений: 13
По умолчанию Анализ продаж за 2 периода

Здравствуйте, уважаемые! Прошу помочь делом или советом, как автоматизировать данный процесс.

Имеется:

Продажи с 2 периодов в РУБ и ШТ. (пример во вложении)

Столбец с АААА (Сумма индикатор) формируется следующим образом:

Сначала находим 80% от всех продаж под итогом.

Сортируем по столбцу первого периода Продажи в руб, выделяем с первых позиций до тех пор, пока сумма не будет доходить до 80% от общих продаж. В столбец Индикатор 1 протягиваем "А" напротив этих позиций. Далее сортируем по убыванию столбец продаж в ШТ (сортируем вместе с Индикатор 1), таким же образом протягиваем позиции и так до индикатора 4. Далее суммируем ячейки индикаторов.

Помогите, пожалуйста, автоматизировать это.

Заранее благодарю!
Вложения
Тип файла: xlsx Книга1.xlsx (22.1 Кб, 19 просмотров)
scumfck вне форума Ответить с цитированием
Старый 07.12.2017, 14:36   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Классический паретто 80/20?

Запись макрорекордером
Код:
Sub Макрос1()
'
' Макрос1 Макрос
'

'
    Dim cl As Range
    Range("L3:L163").Clear
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range( _
            "C3:C163"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        .SetRange Range("A2:n163")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        Range("L3").FormulaR1C1 = "=SUM(R2C3:RC[-9])/SUM(R3C3:R163C3)"
        Range("M3").FormulaR1C1 = "=IF(RC[-1]<0.8,""A"","""")"
        Range("L3:M3").Copy
        Range("L3:M163").PasteSpecial xlPasteAll
        For Each cl In Range("M3:M163")
            cl.Offset(0, 1) = cl & cl.Offset(0, 1)
        Next
        
        .SortFields.Clear
        .SortFields.Add Key:=Range( _
            "D3:D163"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        .SetRange Range("A2:n163")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        Range("L3").FormulaR1C1 = "=SUM(R2C4:RC4)/SUM(R3C4:R163C4)"
        Range("M3").FormulaR1C1 = "=IF(RC[-1]<0.8,""A"","""")"
        Range("L3:M3").Copy
        Range("L3:M163").PasteSpecial xlPasteAll
        For Each cl In Range("M3:M163")
            cl.Offset(0, 1) = cl & cl.Offset(0, 1)
        Next
        
        .SortFields.Clear
        .SortFields.Add Key:=Range( _
            "E3:E163"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        .SetRange Range("A2:n163")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        Range("L3").FormulaR1C1 = "=SUM(R2C5:RC5)/SUM(R3C5:R163C5)"
        Range("M3").FormulaR1C1 = "=IF(RC[-1]<0.8,""A"","""")"
        Range("L3:M3").Copy
        Range("L3:M163").PasteSpecial xlPasteAll
        For Each cl In Range("M3:M163")
            cl.Offset(0, 1) = cl & cl.Offset(0, 1)
        Next
        
        .SortFields.Clear
        .SortFields.Add Key:=Range( _
            "F3:F163"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        .SetRange Range("A2:n163")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        Range("L3").FormulaR1C1 = "=SUM(R2C6:RC6)/SUM(R3C6:R163C6)"
        Range("M3").FormulaR1C1 = "=IF(RC[-1]<0.8,""A"","""")"
        Range("L3:M3").Copy
        Range("L3:M163").PasteSpecial xlPasteAll
        For Each cl In Range("M3:M163")
            cl.Offset(0, 1) = cl & cl.Offset(0, 1)
        Next
    End With
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 07.12.2017, 14:47   #3
scumfck
Пользователь
 
Регистрация: 29.05.2017
Сообщений: 13
По умолчанию

Так точно! Благодарю!
scumfck вне форума Ответить с цитированием
Старый 07.12.2017, 15:05   #4
scumfck
Пользователь
 
Регистрация: 29.05.2017
Сообщений: 13
По умолчанию

Aleksandr H.


А можно сделать этот макрос более гибким по кол-ву строк?
scumfck вне форума Ответить с цитированием
Старый 07.12.2017, 15:26   #5
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Все можно, но Вы просили помочь, а не сделать всю работу вместо Вас
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Разбивка периода даты на месяцы cool_dude Visual C++ 0 22.04.2015 14:39
Разность периода времени Aleksey1989 Microsoft Office Excel 1 08.03.2013 18:37
Выбор периода с исключением alexvav БД в Delphi 10 18.07.2012 13:16
Выбор периода в сводной таблице mrs.petrushina Microsoft Office Excel 2 08.03.2011 21:31
Выбор периода времени DateTimePicker AnkaP Общие вопросы Delphi 8 25.01.2010 18:41