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

Вход

Регистрация

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

 

= Мир MS Excel/Средневзвешенное значение по условию - Мир MS Excel

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

Excel 2010
Есть исходная tabl1 (строк может быть более 50 000). Можно ли макросом найти средневзвешенное значение "Р.цены" для каждого уникального значения "ОПТ" отдельно для сумм положительных и отрицательных объёмов и отобразить эти значения, создав tabl5.
К сообщению приложен файл: sredn.xlsm(12.2 Kb)


Сообщение отредактировал vlavaden - Воскресенье, 24.06.2018, 11:38
 
Ответить
СообщениеЕсть исходная tabl1 (строк может быть более 50 000). Можно ли макросом найти средневзвешенное значение "Р.цены" для каждого уникального значения "ОПТ" отдельно для сумм положительных и отрицательных объёмов и отобразить эти значения, создав tabl5.

Автор - vlavaden
Дата добавления - 24.06.2018 в 09:26
abtextime Дата: Воскресенье, 24.06.2018, 11:46 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 827
Репутация: 117 ±
Замечаний: 0% ±

Excel 2010
Решение на Листе 2

G
Код
=Opt(tabl14[ОПТ];ЦЕЛОЕ(СТРОКА()/2))

H
Код
=ЕСЛИ(ЕЧЁТН(СТРОКА());СУММЕСЛИМН(tabl14[Объем];tabl14[ОПТ];[@ОПТ];tabl14[Объем];">0");"")

I
Код
=ЕСЛИ(ЕЧЁТН(СТРОКА());"";СУММЕСЛИМН(tabl14[Объем];tabl14[ОПТ];[@ОПТ];tabl14[Объем];"<0"))

J
Код
=СУММЕСЛИМН(tabl14[Р.цена];tabl14[ОПТ];[@ОПТ];tabl14[Объем];ЕСЛИ(ЕЧЁТН(СТРОКА());">";"<")&"0")/СЧЁТЕСЛИМН(tabl14[ОПТ];[@ОПТ];tabl14[Объем];ЕСЛИ(ЕЧЁТН(СТРОКА());">";"<")&"0")


UDF Opt()

[vba]
Код
Public Function Opt(RR As Range, N As Long) As Variant
    Dim A() As Long
    ReDim A(1 To RR.Rows.Count)
    For Each R In RR
        Found = False
        For i = 1 To Counter
            If R.Value = A(i) Then
                Found = True
                Exit For
            End If
        Next i
        If Not Found Then
            Counter = Counter + 1
            A(Counter) = R.Value
        End If
    Next R
       
    l = 1
    
    For i = (l + 1) To Counter
        buf = A(i)
        j = i - 1
        Do While (A(j) < buf)
            A(j + 1) = A(j)
            j = j - 1
            If j < l Then Exit Do
        Loop
        A(j + 1) = buf
    Next i
    
    If N > Counter Then
        Opt = ""
        Else: Opt = A(Counter - N + 1)
    End If
    
End Function
[/vba]

Алгоритм сортировки взят отсюда (метод вставки)
К сообщению приложен файл: 6508989.xlsm(23.3 Kb)
 
Ответить
СообщениеРешение на Листе 2

G
Код
=Opt(tabl14[ОПТ];ЦЕЛОЕ(СТРОКА()/2))

H
Код
=ЕСЛИ(ЕЧЁТН(СТРОКА());СУММЕСЛИМН(tabl14[Объем];tabl14[ОПТ];[@ОПТ];tabl14[Объем];">0");"")

I
Код
=ЕСЛИ(ЕЧЁТН(СТРОКА());"";СУММЕСЛИМН(tabl14[Объем];tabl14[ОПТ];[@ОПТ];tabl14[Объем];"<0"))

J
Код
=СУММЕСЛИМН(tabl14[Р.цена];tabl14[ОПТ];[@ОПТ];tabl14[Объем];ЕСЛИ(ЕЧЁТН(СТРОКА());">";"<")&"0")/СЧЁТЕСЛИМН(tabl14[ОПТ];[@ОПТ];tabl14[Объем];ЕСЛИ(ЕЧЁТН(СТРОКА());">";"<")&"0")


UDF Opt()

[vba]
Код
Public Function Opt(RR As Range, N As Long) As Variant
    Dim A() As Long
    ReDim A(1 To RR.Rows.Count)
    For Each R In RR
        Found = False
        For i = 1 To Counter
            If R.Value = A(i) Then
                Found = True
                Exit For
            End If
        Next i
        If Not Found Then
            Counter = Counter + 1
            A(Counter) = R.Value
        End If
    Next R
       
    l = 1
    
    For i = (l + 1) To Counter
        buf = A(i)
        j = i - 1
        Do While (A(j) < buf)
            A(j + 1) = A(j)
            j = j - 1
            If j < l Then Exit Do
        Loop
        A(j + 1) = buf
    Next i
    
    If N > Counter Then
        Opt = ""
        Else: Opt = A(Counter - N + 1)
    End If
    
End Function
[/vba]

Алгоритм сортировки взят отсюда (метод вставки)

Автор - abtextime
Дата добавления - 24.06.2018 в 11:46
vlavaden Дата: Воскресенье, 24.06.2018, 13:56 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 69
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
abtextime, Спасибо, но дробные числа, почему-то округлят и с большим количеством строк зависает надолго.
К сообщению приложен файл: 6508989-1-.xlsm(24.8 Kb)
 
Ответить
Сообщениеabtextime, Спасибо, но дробные числа, почему-то округлят и с большим количеством строк зависает надолго.

Автор - vlavaden
Дата добавления - 24.06.2018 в 13:56
abtextime Дата: Воскресенье, 24.06.2018, 14:23 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 827
Репутация: 117 ±
Замечаний: 0% ±

Excel 2010
Дробные ... лечится заменой
[vba]
Код
Dim A() As Long
[/vba]
на
[vba]
Код
Dim A() As Double
[/vba]

Что касается времени выполнения, то да, в каждой ячейке столбца G идет сортировка внутри функции Opt()

Можно в два раза сократить время путем корректировки формулы в G:
Код
=ЕСЛИ(ЕЧЁТН(СТРОКА());Opt(tabl14[ОПТ];СТРОКА()/2);G1)


Ну и, если чистку дубликатов и сортировку вынести из функции в процедуру и выполнять ее только один раз, то тоже можно резко ускориться. Надо?
К сообщению приложен файл: 0404450.xlsm(24.3 Kb)
 
Ответить
СообщениеДробные ... лечится заменой
[vba]
Код
Dim A() As Long
[/vba]
на
[vba]
Код
Dim A() As Double
[/vba]

Что касается времени выполнения, то да, в каждой ячейке столбца G идет сортировка внутри функции Opt()

Можно в два раза сократить время путем корректировки формулы в G:
Код
=ЕСЛИ(ЕЧЁТН(СТРОКА());Opt(tabl14[ОПТ];СТРОКА()/2);G1)


Ну и, если чистку дубликатов и сортировку вынести из функции в процедуру и выполнять ее только один раз, то тоже можно резко ускориться. Надо?

Автор - abtextime
Дата добавления - 24.06.2018 в 14:23
vlavaden Дата: Воскресенье, 24.06.2018, 14:32 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 69
Репутация: 0 ±
Замечаний: 0% ±

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

Было бы неплохо, Excel мне плохо даётся.
 
Ответить
Сообщение
Ну и, если чистку дубликатов и сортировку вынести из функции в процедуру и выполнять ее только один раз, то тоже можно резко ускориться. Надо?

Было бы неплохо, Excel мне плохо даётся.

Автор - vlavaden
Дата добавления - 24.06.2018 в 14:32
abtextime Дата: Воскресенье, 24.06.2018, 14:48 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 827
Репутация: 117 ±
Замечаний: 0% ±

Excel 2010
Не знаю, насколько всё глобально правильно, но на Вашем примере работает.

Решение с процедурой на Листе3

Макрос подвешен на Ctrl+q

[vba]
Код
Public Sub OptSub()
    Dim A(1 To 1000) As Double
    For Each R In ActiveSheet.ListObjects("tabl148").ListColumns(1).Range
        Found = False
        For i = 1 To Counter
            If R.Value = A(i) Then
                Found = True
                Exit For
            End If
        Next i
        If Not Found And IsNumeric(R.Value) Then
            Counter = Counter + 1
            A(Counter) = R.Value
        End If
    Next R
       
    l = 1
    
    For i = (l + 1) To Counter
        buf = A(i)
        j = i - 1
        Do While (A(j) < buf)
            A(j + 1) = A(j)
            j = j - 1
            If j < l Then Exit Do
        Loop
        A(j + 1) = buf
    Next i
    
    For i = 1 To Counter
        ActiveSheet.ListObjects("tabl559").Range.Cells(2 * i, 1).Value = A(Counter - i + 1)
        ActiveSheet.ListObjects("tabl559").Range.Cells(2 * i + 1, 1).Value = A(Counter - i + 1)
    Next i
    
End Sub
[/vba]
К сообщению приложен файл: 9030642.xlsm(31.5 Kb)
 
Ответить
СообщениеНе знаю, насколько всё глобально правильно, но на Вашем примере работает.

Решение с процедурой на Листе3

Макрос подвешен на Ctrl+q

[vba]
Код
Public Sub OptSub()
    Dim A(1 To 1000) As Double
    For Each R In ActiveSheet.ListObjects("tabl148").ListColumns(1).Range
        Found = False
        For i = 1 To Counter
            If R.Value = A(i) Then
                Found = True
                Exit For
            End If
        Next i
        If Not Found And IsNumeric(R.Value) Then
            Counter = Counter + 1
            A(Counter) = R.Value
        End If
    Next R
       
    l = 1
    
    For i = (l + 1) To Counter
        buf = A(i)
        j = i - 1
        Do While (A(j) < buf)
            A(j + 1) = A(j)
            j = j - 1
            If j < l Then Exit Do
        Loop
        A(j + 1) = buf
    Next i
    
    For i = 1 To Counter
        ActiveSheet.ListObjects("tabl559").Range.Cells(2 * i, 1).Value = A(Counter - i + 1)
        ActiveSheet.ListObjects("tabl559").Range.Cells(2 * i + 1, 1).Value = A(Counter - i + 1)
    Next i
    
End Sub
[/vba]

Автор - abtextime
Дата добавления - 24.06.2018 в 14:48
vlavaden Дата: Воскресенье, 24.06.2018, 16:58 | Сообщение № 7
Группа: Пользователи
Ранг: Участник
Сообщений: 69
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
abtextime, Спасибо, сейчас летает. Скажите, а этот код в макросе к чему?
[vba]
Код
Public Sub aaa()
MsgBox (Opt(Range("A2:A22"), 1))
End Sub
[/vba]


Сообщение отредактировал vlavaden - Воскресенье, 24.06.2018, 16:59
 
Ответить
Сообщениеabtextime, Спасибо, сейчас летает. Скажите, а этот код в макросе к чему?
[vba]
Код
Public Sub aaa()
MsgBox (Opt(Range("A2:A22"), 1))
End Sub
[/vba]

Автор - vlavaden
Дата добавления - 24.06.2018 в 16:58
abtextime Дата: Воскресенье, 24.06.2018, 17:06 | Сообщение № 8
Группа: Проверенные
Ранг: Ветеран
Сообщений: 827
Репутация: 117 ±
Замечаний: 0% ±

Excel 2010
vlavaden, это уберите, нужно было для отладки функции. Да и функцию удалите, она не нужна
 
Ответить
Сообщение vlavaden, это уберите, нужно было для отладки функции. Да и функцию удалите, она не нужна

Автор - abtextime
Дата добавления - 24.06.2018 в 17:06
vlavaden Дата: Воскресенье, 24.06.2018, 21:34 | Сообщение № 9
Группа: Пользователи
Ранг: Участник
Сообщений: 69
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Уважаемый abtextime, макрос прекрасно работает, вот только формула для нахождения средневзвешенного значения не верна. Вы не могли бы исправить? Пример в файле.
К сообщению приложен файл: 9030642-1-.xlsm(29.5 Kb)


Сообщение отредактировал vlavaden - Воскресенье, 24.06.2018, 21:34
 
Ответить
СообщениеУважаемый abtextime, макрос прекрасно работает, вот только формула для нахождения средневзвешенного значения не верна. Вы не могли бы исправить? Пример в файле.

Автор - vlavaden
Дата добавления - 24.06.2018 в 21:34
_Boroda_ Дата: Воскресенье, 24.06.2018, 22:21 | Сообщение № 10
Группа: Модераторы
Ранг: Местный житель
Сообщений: 12659
Репутация: 5191 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Так нужно?
Код
=ЕСЛИ(ИНДЕКС(tabl559[@[Объем +]:[Объем -]];1+([@ОПТ]=G1));СУММПРОИЗВ(tabl148[Р.цена]*tabl148[Объем]*(tabl148[ОПТ]=[@ОПТ])*(tabl148[Объем]*-1^([@[Объем -]]<0)>0))/СУММ(tabl559[@[Объем +]:[Объем -]]);)


Кусок
Код
=ЕСЛИ(ИНДЕКС(tabl559[@[Объем +]:[Объем -]];1+([@ОПТ]=G1));
хоть и много места в формуле занимает, но зато заранее отсекает все нулевые значения, что на Вашем объеме важно - СУММПРОИЗВ не так быстра, как СУММЕСЛИ

В столбце J формат ячеек
0,00;-0,00;
- нули не видны
Можно и так
0,00;;
К сообщению приложен файл: 9030642-1-1-1-1.xlsm(29.9 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТак нужно?
Код
=ЕСЛИ(ИНДЕКС(tabl559[@[Объем +]:[Объем -]];1+([@ОПТ]=G1));СУММПРОИЗВ(tabl148[Р.цена]*tabl148[Объем]*(tabl148[ОПТ]=[@ОПТ])*(tabl148[Объем]*-1^([@[Объем -]]<0)>0))/СУММ(tabl559[@[Объем +]:[Объем -]]);)


Кусок
Код
=ЕСЛИ(ИНДЕКС(tabl559[@[Объем +]:[Объем -]];1+([@ОПТ]=G1));
хоть и много места в формуле занимает, но зато заранее отсекает все нулевые значения, что на Вашем объеме важно - СУММПРОИЗВ не так быстра, как СУММЕСЛИ

В столбце J формат ячеек
0,00;-0,00;
- нули не видны
Можно и так
0,00;;

Автор - _Boroda_
Дата добавления - 24.06.2018 в 22:21
vlavaden Дата: Воскресенье, 24.06.2018, 22:35 | Сообщение № 11
Группа: Пользователи
Ранг: Участник
Сообщений: 69
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, Всё верно, вроде бы, сейчас проверю


Сообщение отредактировал vlavaden - Воскресенье, 24.06.2018, 22:39
 
Ответить
Сообщение_Boroda_, Всё верно, вроде бы, сейчас проверю

Автор - vlavaden
Дата добавления - 24.06.2018 в 22:35
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Средневзвешенное значение по условию (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

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