MS, Libreoffice & Google docs

Основную сложность здесь представляет поиск цены, так как надо искать и по бренду, и по упаковке. Есть 2 способа решения: 1) простой, развернутый, с доп.столбцами, и 2) компактный, но требующий определенных навыков работы.

Способ 1

Были бы исходные данные только в одном столбце (и бренд, и упаковка), искать можно было бы обычным ВПР. Но данные в 2-х столбцах. Поэтому для начала объединим бренд и упаковку в одно наименование:

1. Создадим новый столбец (С) с формулой: =А3&В3.

2. Аналогичный столбец создадим и в маленькой таблице:

3. Теперь, когда искомые значения готовы, с помощью ВПР можно выполнить поиск. Создаем еще один новый столбец (D) с формулой: =ВПР(C3;$N$3:$O$8;2;0), где

С3 — искомое значение, $N$3:$O$8 — диапазон с таблицей поиска,

2 — столбец для вывода информации, 0 — точный поиск:

4. Теперь, когда цена найдена, можно рассчитать конечные суммы:

В общем, все! Все найдено, все подсчитано. В несколько шагов, правда. Продуктивно. Но не изящно.

Поэтому предлагаю

Способ 2.

Сразу и поиск, и подсчет реализуем в окончательных столбцах. При этом принцип будет аналогичный: исходные данные требуют объединения (&).

Итак, действия:

1. Объединить 2 ячейки в момент поиска с указанием также 2-х объединенных столбцов для поиска может функция ПОИСКПОЗ. Для этого связку А3&B3 помещаем как искомое значение, а массивом поиска станет такая же связка J3:J8&K3:K8. Вот так:

=ПОИСКПОЗ(A3&B3; J3:J8&K3:K8; 0)

2. При этом ПОИСКПОЗ сам по себе найдет только позицию результата, поэтому помещаем его в ИНДЕКС. Вот так будет выглядеть окончательная формула:

=ИНДЕКС(J3:L8;ПОИСКПОЗ(A3&B3;J3:J8&K3:K8;0);3)

где

J3:L8 — таблица с ценами,

3 — номер столбца с ценой:

3. Для завершения формулы осталось только дописать *С3 (умножить на объем в январе) и проставить закрепления ($) во все диапазоны (обратите внимание, закрепление не везде абсолютное):

4. ОЧЕНЬ ВАЖНЫЙ ПУНКТ!

Если у вас Excel не 365, а другой -  ничего, что сделано выше, работать не будет, если не выполнить теперь этот шаг!

Обычные формулы ПОИСКПОЗ и ИНДЕКС не могут поддерживать связки с такими объединениями (&), поэтому завершать ввод формулы будем не [Enter], а [Ctrl]+[Shift]+[Enter]. Это формула массива, ее можно вводить только так! Иначе будет ошибка. И при любых изменениях формулы заканчиваем редактирование тоже сочетанием [Ctrl]+[Shift]+[Enter].

Если у вас Excel 365, нажимайте просто [Enter], там массивы уже более современные.

А вот копировать формулу (растягивать по столбцам) можно уже как обычно. Полностью законченная таблица выглядит так:

Все расчеты при этом получилось сделать в нужных столбцах без добавления дополнительных столбцов.

Ну а теперь пройдём все шаги вместе.

В прошлом посте я говорил про макрос расчёта на основании построения тренда.

====

' Апроксимация полиномом для всего массива исходных данных

' В подпрограмму передаются все заданные точки и апроксимация ведётся по всем точкам!

' Данные из листа Excel

Public Function polinomEx_all(xVal As Range, yVal As Range, x As Single, Optional stepen As Long = 2) As Variant

Dim i As Integer

' Проверка требования "число элементов массива на 1 больше чем степень полинома"

If xVal.Count < stepen + 1 Then

stepen = xVal.Count - 1

End If

polinomEx_all = 0#

Select Case stepen

Case 1 ' Уравнение а·х+b

For i = 1 To stepen + 1

polinomEx_all = polinomEx_all + (x ^ (stepen + 1 - i)) * Application.Index(WorksheetFunction.LinEst(yVal, xVal, True, True), 1, i)

Next i

Case 2 ' Уравнение а·х^2+b·x+c

For i = 1 To stepen + 1

polinomEx_all = polinomEx_all + _

(x ^ (stepen + 1 - i)) * Application.Index(WorksheetFunction.LinEst(yVal, Application.Power(xVal, Array(1, 2)), True, True), 1, i)

Next i

Case 3 ' Уравнение а·х^3+b·x^2+c·x+d

For i = 1 To stepen + 1

polinomEx_all = polinomEx_all + _

(x ^ (stepen + 1 - i)) * Application.Index(WorksheetFunction.LinEst(yVal, Application.Power(xVal, Array(1, 2, 3)), True, True), 1, i)

Next i

Case 4 ' Уравнение а·х^4+b·x^3+c·x^2+d·x+e

For i = 1 To stepen + 1

polinomEx_all = polinomEx_all + _

(x ^ (stepen + 1 - i)) * Application.Index(WorksheetFunction.LinEst(yVal, Application.Power(xVal, Array(1, 2, 3, 4)), True, True), 1, i)

Next i

Case 5 ' Уравнение а·х^5+b·x^4+c·x^3+d·x^2+e·x+f

For i = 1 To stepen + 1

polinomEx_all = polinomEx_all + _

(x ^ (stepen + 1 - i)) * Application.Index(WorksheetFunction.LinEst(yVal, Application.Power(xVal, Array(1, 2, 3, 4, 5)), True, True), 1, i)

Next i

Case 6 ' Уравнение а·х^6+b·x^5+c·x^4+d·x^3+e·x^2+f·x+g

For i = 1 To stepen + 1

polinomEx_all = polinomEx_all + _

(x ^ (stepen + 1 - i)) * Application.Index(WorksheetFunction.LinEst(yVal, Application.Power(xVal, Array(1, 2, 3, 4, 5, 6)), True, True), 1, i)

Next i

Case 7 ' Уравнение а·х^7+b·x^6+c·x^5+d·x^4+e·x^3+f·x^2+g·x+h

For i = 1 To stepen + 1

polinomEx_all = polinomEx_all + _

(x ^ (stepen + 1 - i)) * Application.Index(WorksheetFunction.LinEst(yVal, Application.Power(xVal, Array(1, 2, 3, 4, 5, 6, 7)), True, True), 1, i)

Next i

Case Else

End Select

End Function

====

Т.е.

WorksheetFunction.LinEst(yVal, Application.Power(xVal, Array(1, 2, 3, 4)), True, True)

полностью совпадает с

ЛИНЕЙН(Y; X{1;2;3;4}; True; True)

Ну а теперь просто заменим расчёт на составление текстовой переменной

=====

' Апроксимация полиномом для всего массива исходных данных

' В подпрограмму передаются все заданные точки и апроксимация ведётся по всем точкам!

' Данные из листа Excel

' Результат работы программы - текст (уравнение полинома)

Public Function polinomExStr(ByVal xVal As Range, ByVal yVal As Range, Optional stepen As Long = 2) As Variant

' Проверка требования "число элементов массива на 1 больше чем степень полинома"

Dim i As Integer

If xVal.Count < stepen + 1 Then

stepen = xVal.Count - 1

End If

polinomExStr = ""

Select Case stepen

Case 1 ' Уравнение а·x+c

For i = 1 To 2

polinomExStr = polinomExStr & " + X ^ " & (2 - i) & " * " _

& Format(Application.Index(WorksheetFunction.LinEst(yVal, Application.Power(xVal, Array(1)), True, True), 1, i), "0.###E+")

Next i

Case 2 ' Уравнение а·х^2+b·x+c

For i = 1 To 3

polinomExStr = polinomExStr & " + X ^ " & (3 - i) & " * " _

& Format(Application.Index(WorksheetFunction.LinEst(yVal, Application.Power(xVal, Array(1, 2)), True, True), 1, i), "0.###E+")

Next i

Case 3 ' Уравнение а·х^3+b·x^2+c·x+d

For i = 1 To 4

polinomExStr = polinomExStr & " + X ^ " & (4 - i) & " * " _

& Format(Application.Index(WorksheetFunction.LinEst(yVal, Application.Power(xVal, Array(1, 2, 3)), True, True), 1, i), "0.###E+")

Next i

Case 4 ' Уравнение а·х^4+b·x^3+c·x^2+d·x+e

For i = 1 To 5

polinomExStr = polinomExStr & " + X ^ " & (5 - i) & " * " _

& Format(Application.Index(WorksheetFunction.LinEst(yVal, Application.Power(xVal, Array(1, 2, 3, 4)), True, True), 1, i), "0.###E+")

Next i

Case 5 ' Уравнение а·х^5+b·x^4+c·x^3+d·x^2+e·x+f

For i = 1 To 6

polinomExStr = polinomExStr & " + X ^ " & (6 - i) & " * " _

& Format(Application.Index(WorksheetFunction.LinEst(yVal, Application.Power(xVal, Array(1, 2, 3, 4, 5)), True, True), 1, i), "0.###E+")

Next i

Case 6 ' Уравнение а·х^6+b·x^5+c·x^4+d·x^3+e·x^2+f·x+g

For i = 1 To 7

polinomExStr = polinomExStr & " + X ^ " & (7 - i) & " * " _

& Format(Application.Index(WorksheetFunction.LinEst(yVal, Application.Power(xVal, Array(1, 2, 3, 4, 5, 6)), True, True), 1, i), "0.###E+")

Next i

Case 7 ' Уравнение а·х^7+b·x^6+c·x^5+d·x^4+e·x^3+f·x^2+g·x+h

For i = 1 To 8

polinomExStr = polinomExStr & " + X ^ " & (8 - i) & " * " _

& Format(Application.Index(WorksheetFunction.LinEst(yVal, Application.Power(xVal, Array(1, 2, 3, 4, 5, 6, 7)), True, True), 1, i), "0.###E+")

Next i

Case Else

End Select

End Function

=====

Ну или немного в другом виде с учётом ряда особенностей и модификаций

=====

' Программа формирования текста макроса для функции одного уравнения

Public Function fun_macros_Y(xVal As Range, yVal As Range, PolyStep As Long, _

Optional Name_f As String = "Nomogramma", _

Optional Opisanie As String = " Уравнение ", _

Optional NameX As String = "Xisk") As Variant

Dim j As Long

Dim N As Long

Dim k As Long

Dim stepen As Long

Dim xn() As Double ' заявляем массив X

Dim yn() As Double ' заявляем массив Y

Dim c() As Double ' заявляем массив c - коэффециенты уравнения полинома

fun_macros_Y = "" & Chr(10) & "' " & Opisanie & Chr(10)

fun_macros_Y = fun_macros_Y & "Public Function " & Name_f & "(ByRef " & NameX & " As Single) As Variant" & Chr(10)

Dim Nna4 As Long 'Номер начала диапазона.

Dim Nkon As Long 'Номер конца диапазона.

Nna4 = 1

Nkon = xVal.Count

' Проверяем на соответствие число элементов участка степени полинома

If (Nkon - Nna4) < PolyStep Then

stepen = (Nkon - Nna4)

Else

stepen = PolyStep

End If

' Заполняем матрицы участка

ReDim xn(1 To (Nkon - Nna4 + 1), 1 To stepen)

ReDim yn(1 To (Nkon - Nna4 + 1), 1 To 1)

ReDim c(1 To stepen + 1) As Double

For j = 1 To (Nkon - Nna4 + 1)

xn(j, 1) = xVal.Rows(j + Nna4 - 1)

For N = 2 To stepen

xn(j, N) = xn(j, 1) ^ N

Next N

yn(j, 1) = yVal.Rows(j + Nna4 - 1)

Next j

' Делаем расчёт и вывод.

fun_macros_Y = fun_macros_Y & Name_f & " = "

For k = 1 To stepen + 1 Step 1

c(k) = Format(Application.Index(WorksheetFunction.LinEst(yn, xn, True, True), 1, k), "0.####E+")

If c(k) >= 0 And k > 1 Then

fun_macros_Y = fun_macros_Y & " + " & c(k)

Else

fun_macros_Y = fun_macros_Y & c(k)

End If

If (stepen + 1 - k) > 0 Then

fun_macros_Y = fun_macros_Y & " * " & NameX & " ^ " & (stepen + 1 - k) & " "

End If

Next k

fun_macros_Y = fun_macros_Y & Chr(10) & "End Function" & Chr(10)

End Function

=====

Макрос ждёт в качестве вводных данных:

xVal - столбец известных Х

yVal - столбец известных Y

PolyStep - желаемую степень уравнения. Если точек будет меньше чем требуется для степени - на уменьшится

Name_f - название получаемого макроса. Опционально. Если не задать будет Nomogramma

Opisanie - описание получаемого макроса. Опционально. Если не задать будет Уравнение

NameX - название/имя аргумента. Опционально. Если не задать будет Xisk

Вызов макроса:

=ПОДСТАВИТЬ(fun_macros_Y(X; Y; 3; "fun_пример"; "Пример создания макроса"; "Go");",";".")

=ПОДСТАВИТЬ( ;",";".") требуется для замены запятых на точки. Иначе будет казус - VBA в качестве разделителя целой и дробной части использует точку, а в текстом виде (по крайней мере в рус.экселе) разделитель запятая.

Обратите внимание, что

"fun_пример"; "Пример создания макроса"; "Go" - текстовые, т.е. заключаются в кавычки

"fun_пример";  "Go" - должны соответствовать требованиям к переменным. Т.е. не должны содержать пробелов, не должны совпадать с имеющимися переменными или названиями ячеек/диапазонов.

Результатом выполнения макроса будет (поставил 3-ю степень чтобы результат влез в окно поста):

"

' Пример создания простого макроса

Public Function fun_Wтф(ByRef Go As Single) As Variant

fun_Wтф = 0.00000056401 * Go ^ 3 -0.001952 * Go ^ 2 + 1.3842 * Go ^ 1 + 25.341

End Function

"

Останется скопировать данный текст в модуль VBA и удалить двойные кавычки в начале и конце текстовки.

Если есть желание повысить количество знаков коэффициентов - правим формат "0.####E+"

Для ускорения работы у меня собраны листы/шаблоны позволяющие не лезть в заполнение вызова макросов.

Вызов макроса для данного случая у меня выглядит так (в Е9):

=ПОДСТАВИТЬ(fun_macros_Y(B3:ДВССЫЛ("B"&E4);C3:ДВССЫЛ("C"&E4);M7;E7;G5;G7);",";".")

Как заполнены дополнительные столбцы А, D и ячейки Е4 и т.д. видно на скрине.

Столбец А - контроль верности снятия данных (по возрастанию Х).

Столбец D - подсчёт снятых точек.

В итоге выполнение/изготовление макроса для меня сводится в вставке исходных данных начиная с ячейки В3, и затем жёлтых полей ввода описания, ввода названия новой функции и аргумента, выбора степени. Т.е. занимает не более минуты.

Для наблюдательных - присутствующие в макросе Dim Nna4 As Long 'Номер начала диапазона.

Dim Nkon As Long 'Номер конца диапазона.

намекают на то, что после небольшой модификации данный макрос можно использовать для более сложных диаграмм. Но об этом позднее... Думаю что через неделю в лучшем случае.

Для продвинутых - да, можно обойтись без доп.столбцов А и D, да и E4 лишнее. И то и другое можно реализовать в макросе, но...но данный лист был так сформирован на основании удобства для меня - могу оперативно проверить правильность и полноту вставки исходных данных, отсутствие сбоев "снятия" точек с картинки при массовой оцифровке. И вообще - "работает? Стабильно? Без сбоев? Не трожь!" (с)Анекдот. Вам ничто не мешает сделать иначе.

=========

dixi

Краткий план:

Теория вкратце [ Часть 1. ]

Забираем данные с листа. [ Часть 2. ]

Апроксимация простых графиков полиномом средствами Excel [ Часть 3.]

Макрос по созданию макросов апроксимации простых графиков полиномом [ Часть 4.] Этот пост

Апроксимация графиков двух аргументов полиномом [ Часть 5.]

Кусочная интерполяция простых графиков [ Часть 6.]

Стоит учитывать, что описанный ниже способ подходит только в ограниченном количестве случаев:

- требует заказчик;

- зависимость явно полиномиальная.

Итак, в общем случае всё сводится к пяти шагам:

1. По имеющимся данным построить точечный график.

2. По построенным точкам выполнить построение линии тренда.

3. Подобрать степень полиномиальной зависимости таким образом, чтобы внешний вид (прохождение около/через заданные точки) соответствовал изначальному графику (тот что был на картинке). Проверить, возможно полином не лучший вариант.

4. Отобразить уравнение линии тренда на диаграмме и, если зависимость полиномиальная, становить формат чисел "Экспоненциальный" Число знаков - не менее 3х знаков.

5. Скопировать полученное уравнение и использовать в дальнейшем.

Есть ли способы без построения? Естественно есть (о них чуть подальше), но не видя как расположена линия тренда можно нарваться на неприятности.

Ещё одно заблуждение - "чем больше степень полинома, тем точнее". К сожалению, если по оси Х значения в десятках тысяч, а по оси Y в единицах фактически не реально найти полином выше 5-й степени. Точнее определить с достаточной достоверностью его коэффициенты (просто не хватает 15-ти знаков).

Определение коэффициентов полинома.

Как видно на скриншоте выше извлечение коэффициентов полинома происходит совсем не сложно.

=ИНДЕКС(ЛИНЕЙН(F4:F13;E4:E13^{1;2;3;4;5;6});1;7)

где {1;2;3;4;5;6} - степень полинома, 7 - порядковый номер коэффициента.

И об этом написано в многих местах. Но вот то что не написано - извлечённые таким способом иногда не совсем соответствуют коэф-ам уравнения на диаграмме, а иногда совсем не соответствуют.

Это внутренняя математика Excel и  может быть вызвано целым рядом причин. Основные:

- Значительный разрыв исходных данных. Например есть несколько сот снятых точек от 0 до 10, затем отсутствие снятых точек от 10 до 20, затем несколько сот точек с 20 до 50.

- Значительные степени чисел (как на скрине выше).

Выходом из данной ситуации является следующий макрос-костыль который забирает данные из указанного диапазона ( в примере - "B2:B6"  Данные Х  и "C2:C6" -  Данные Y), строит график, на графике строит линию тренда с заявленной степенью (в примере вторая - Order = 2), копирует строку уравнения, распарсивает её и выкидывает в столбец (  в примере - начиная с ячейки E2 и вниз) коэффициенты полин.уравнения. Построенный график удаляется...

Sub Polynomial()

Dim rX As Range

Dim rY As Range

Dim rOut As Range

Dim dataLabelText As String

Dim coefficients As Variant

Set rX = ActiveSheet.Range("B2:B6") ' Данные Х

Set rY = ActiveSheet.Range("C2:C6") ' Данные Y

Set rOut = ActiveSheet.Range("E2") ' Место выгрузки коэф-в

dataLabelText = Извлечение_Полинома(rX, rY)

coefficients = Извлечение_коэффициентов(dataLabelText)

With rOut.Resize(UBound(coefficients, 1) + 1, UBound(coefficients, 2))

'назначаем формат для избежания ошибок при вставке получившихся формул

.NumberFormat = "#.####E+00"

.Value = coefficients

End WithEnd Sub

Private Function Извлечение_коэффициентов(dataLabelText As String) As Variant

Dim i As Integer

Dim rez() As Variant, txt As Variant

txt = Split(dataLabelText, "x")

ReDim rez(LBound(txt) To UBound(txt), 1 To 2)

For i = LBound(txt) To UBound(txt)

txt(i) = Right(txt(i), IIf(i = LBound(txt), (Len(txt(i)) - 2), (Len(txt(i)) - 1)))

rez(i, 1) = i: rez(i, 2) = txt(i)

Next i

Извлечение_коэффициентов = rez

End Function

Function Извлечение_Полинома(rX As Range, rY As Range) As String

Dim MyChart As Chart

Dim text As String

Dim dt As Date

Set MyChart = ActiveSheet.Shapes.AddChart2(, , , , 450, 300).Chart

With MyChart

.SeriesCollection.NewSeries

.SeriesCollection(1).XValues = rX

.SeriesCollection(1).Values = rY

.ChartType = xlXYScatter

.FullSeriesCollection(1).Trendlines.Add

With .FullSeriesCollection(1).Trendlines(1)

.Type = xlPolynomial

.Order = 2 ' Указываем степень полинома

.DisplayEquation = True

.DataLabel.NumberFormat = "#.####E+00"

dt = Now

DoEvents ' Задержка. См. ниже

DoEvents ' Задержка. См. ниже

Do

If .DataLabel.text <> "" Then Exit Do

If dt < Now - TimeSerial(0, 1, 0) Then Exit Do

For i = 1 To 100: DoEvents: Next

Loop

text = .DataLabel.text

End With

End With

Извлечение_Полинома = text

MyChart.Parent.Delete

End Function

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

Быстрое определение искомого Y по заданному X.

Если Вы уверены в своём глазомере, не боитесь подводных камней и хотите быстро получить значение, то можно воспользоваться вот таким макросом.

Сокращённый вид макроса за авторством БМВ расположен ниже. Расширенный частично на скрине выше. Он понадобится нам в следующем посте, когда будем делать макрос по созданию макросов ), и там будет представлен полностю.

Public Function polinomEx(xVal As Range, yVal As Range, X As Single, stepen As Integer)

Dim I As Integer

Dim Seria

Seria = Array(1, 2, 3, 4, 5, 6, 7)

If stepen > 7 Then stepen = 7

If xVal.Count < stepen + 1 Then stepen = xVal.Count - 1

polinomEx = 0#

ReDim Preserve Seria(stepen - 1)

For I = 1 To stepen + 1

polinomEx = polinomEx + _

(X ^ (stepen + 1 - I)) * _

Application.Index(WorksheetFunction.LinEst(yVal, _

IIf(stepen = 1, xVal, Application.Power(xVal, Seria)), _

True, True), 1, I)

Next I

End Function

Т.е. в функцию передаются столбцы исходных данных, значение Х, при котором требуется найти Y и степень полинома линии тренда.

И да, все заметили что посредством макроса есть возможность построить полином 7-й степени, тогда как линия тренда позволяет выполнять это только до 6-й?

Дальнейшее использование уравнения апроксимации.

Существует всего два подхода:

- Хранить исходные данные на листе. Или в виде таблицы, или в виде уравнения в ячейке.

- Хранить уравнение в виде макроса.

Первый подход удобен при разовом использовании. Если возможно неоднократное использование зависимости, или возможна её модификация, или зависимостей больше десятка - макрос предпочтительнее.

О том как делать макросы для простых графиков, в том числе и в автоматизированном режиме, расскажу в следующий раз.

===========

Краткий план:

Теория вкратце [ Часть 1. ]

Забираем данные с листа. [ Часть 2. ]

Апроксимация простых графиков полиномом средствами Excel [ Часть 3.] Этот пост

Макрос по созданию макросов апроксимации простых графиков полиномом [ Часть 4.]

Апроксимация графиков двух аргументов полиномом [ Часть 5.]

Кусочная интерполяция простых графиков [ Часть 6.]