Получение макросов интерполяций табличных данных на минималках
Для упрощения жизни тем, кому нужно выполнить обработку табличных данных получив интерполяционные данные для промежуточных значений, или кому надоело ползать по графику в поисках.
Для упрощения жизни тем, кому нужно выполнить обработку табличных данных получив интерполяционные данные для промежуточных значений, или кому надоело ползать по графику в поисках.
Пару лет назад выкладывал тут серию постов и проведении оцифровки номограмм. Вложил и забыл.
Потом делал обучающие видосики по использованию одной из моих разработок по облегчению работы для своих сотрудников. Затем меня попросили на планете эксель показать как делается такая "программа" по автоматизации создания макросов, и я стал потихоньку показывать это. Затем возникла проблема - один из подписчиков попытался подцепить то что я написал на пикабу к тому что я показывал в видео, и у него не получилось... Что естественно поскольку все мы меняемся и наши подходы к решению задач меняются... Но он мне напомнил про мою пикабушную серию, и я решил поделиться. Ссыль на плейлист ниже.
Если есть необходимость/желание научиться автоматизировать оцифровку, то видео с маркировкой 21.* для вас. Если просто по функционалу - весь плейлист в вашем распоряжении.
Сразу скажу - готовых модулей с кодом не дам (почти...). Но весь процесс написания, со всеми узкими местами, будет на видео. На все вопросы отвечу. Ключевое слово - научиться.
Выкладывать все ролики на пикабу, дублируя их, не вижу смысла.
Ну и все вопросы из "почему рутуб" и "зачем это в эксель" оставляю за бортом. Умеете делать лучше? Рад за вас. Делитесь - готов поучиться.
Итак, мы с вами имели рисунок на бумажке, перевели его в цифру (сняли точки), написали макрос, позволяющий определить значение Y по известным аргументам. В некоторых случаях этого достаточно, однако не всегда. Например для отчёта требуется указать поиск решения в графическом виде, поскольку заказчика "я фсио оцифровал! Вы не пониаити, у меня макрос!" не устраивает. Особенно когда речь идёт о больших деньгах, и проводятся гарантийные испытания с определением поправочных коэффициентов (например.). Или преподаватель в институте будет приятно удивлён красивому графику в курсовом проекте/дипломе.
Итак, по сути потребуется решить два вопроса:
1. Построить ход поиска с помощью стрелки/стрелок.
2. Совместить построенный график с изначальным рисунком.
Т.е. получить что то похожее на вот это:
На самом деле нет принципиальной разницы в начале построить поиск решения или в начале совместить рисунок с диаграммой. Но начну с построения, т.к. при этом меньше мусора на рисунках.
Часть 1. Построение поиска решения.
Итак, у нас есть заданные аргументы (G2, t1в) и результат расчёта Р2. На графике сие будет выглядеть как одна точка с координатами X = G2 = 200 (в нашем примере) и Y = Р2 = 0,065
Существуют минимум три метода построения стрелки поиска:
Вариант 1. Для вертикальной и горизонтальной части строим независимые линии.
После построения настраиваем цвета, указываем наличие стрелки, и т.д.
Для вертикальной линии второй точкой указывается точка с равным значением по Х и минимумом по бумажному графику Y.
Для горизонтальной линии второй точкой указывается точка с равным значением по Y и минимумом по бумажному графику X.
Минимумы и максимумы диаграммы выставляются равными минимумам и максимумам бумажного рисунка.
Хоть данный вариант и кажется наиболее раздутым, но на практике, когда линий поиска десяток, он наиболее удобен и понятен.
Вариант 2. Единая линия поиска.
Выставление значений дополнительных точек, и значений осей аналогично Варианту 1.
Вариант 3. Использование погрешностей для указания поиска решения.
Если точка одна, то для отображения линий погрешности необходимо перейти в настройки предела погрешности по Х и по Y поочерёдно и...
Отметить
- минус
- без точки
- величина погрешности "пользовательская".
В качестве отрицательной величины погрешности указываем соответственно значение X и Y
Если есть желание получить стрелку направленную к оси Y, а ось Х начинается не с 0 (в нашем случае с 2-ти), то потребуется сделать ячейку рассчитывающую смещение относительно 0.
В нашем примере сделаем такое и для X и Y:
ось Х сдвинута на 20. Соответственно имеем ячейку Хзаданное - Хсмещения = 200 - 20
ось Y сдвинута на 0,02 Соответственно имеем ячейку Yзаданное - Yсмещения
Это значения не статичны, т.е. они пересчитаются при изменении исходных данных.
При указании отображения погрешностей ссылаемся на данные ячейки.
Аналогично первым вариантам указываются свойства линий.
На самом деле третий способ самый быстрый и лёгкий, это описание сложновато. При наличии необходимости указания поиска для группы точек, и особенно отсутствии смещения 0, вот такие диаграммы делаются наиболее просто именно третьим способом.
Из минусов третьего варианта можно отметить невозможность указания выноски точек около осей, как это делается для первых двух вариантов, т.к. этих точек то и нет фактически на диаграмме.
Однако можно сделать выноску для той самой, единственной точки.
Результаты всех трёх способов не сильно отличаются:
Часть 2. Совмещение построенного графика с изначальным рисунком.
И опять есть минимум три варианта.
Вариант 1. Использование рисунка в качестве подложки под областью построения (то, что расположено внутри границ осей). Для этого рисунок сначала подготавливается (обрезается по размерам построения, при этом подписи осей оказываются обрезанными), а затем вставляется по пути: Формат области построения – Заливка – Рисунки и текстура – Файл / из буфера обмена;
Вариант 2. Использование рисунка в качестве подложки области диаграммы (вкладка Формат области диаграммы – Заливка – Рисунки и текстура - Файл) вставляется рисунок графика (предварительно подготовленный и очищенный. Необходимо также учитывать, что потребуется некоторая ширина полей для выставления подписей). Совмещаются границы графика Excel с границами графика рисунка перетягиванием за маркеры границы графика (перемещение указал стрелками).
выставляются границы осей графика Excel в соответствии с границами графика (если не выставили ранее). При необходимости производится отключение отображения подписей осей, сетка и название диаграммы.
в качестве свойств графика линии указывается её цвет, отсутствие маркеров и окончание графика в виде стрелки и т.д.. т.е. наводится окончательный лоск обеспечивающий хорошую читабельность диаграммы.
при необходимости можно построить дополнительную линию. В качестве примера построена дополнительная кривая при 40°С при помощи созданной пользовательской функции при заданной температуре 40°С и переменной влажности. Аналогично построена дополнительная линия на первом рисунке
Вариант 3. При третьем варианте рисунок вставляется на лист Excel, построенный график/ подготовленная диаграмма размещается над рисунком, при этом заливка поля построения и самой диаграммы "отсутствует" или "прозрачная". После совмещения изображение и диаграмма фиксируются между собой как это было указано в посте "Нестандартные заголовки диаграмм".
Третий вариант позволяет разместить отображение поиска решения для нескольких диаграмм расположенных на одном листе, если таковое требуется заказчиком. Например на рисунке ниже на одном листе 7-мь диаграмм, и в дальнейшем данный рисунок пошёл в отчёт скомпонованный в таком виде.
Отдельно стоят диаграммы состоящие из расположенных рядом двух и более диаграмм.
Их оформление, опять же, может быть реализовано тремя способами.
Способ 1 - применение третьего варианта наложения диаграмм на рисунок (описано выше). Т.е. строим два независимых графика для левой и правой части, делаем их прозрачными и накладываем на рисунок.
Способ 2 - применение первого варианта, наложение графика на область построения (описано выше). Т.е. строим два независимых графика для левой и правой части, накладываем области построения и размещаем взаимно друг другу до совпадения минимума и максимума.
Способ 3. - пригоден только для расположенных рядом двух диаграмм. Данный способ позволяет избавится от стыка, неизбежно возникающего при первых двух способах. Основано как правило на применении второго варианта описанного выше, а именно использовании рисунка как подложки под диаграммой.
Рассмотрим один из вариантов построения стрелки на диаграмме, состоящей из двух диаграмм, при этом ширина клеток и величина шага для правого и левого графика разная.
Для наглядности оси были ярко выражены и отодвинуты относительно области построения, а графики разнесены по цветам.
Шаг 1. Построение левого графика (синий график, синяя ось, синие данные).
1. Построить точечный график по исходным данным, причём заложить небольшой перехлёст по Х (установлено 80 вместо 70-ти по рисунку);
2. Сделать подложку под диаграмму (используется весь рисунок, без обрезок или разделения на две части);
3. Растянуть область построения на рисунок;
4. Задать значения оси (диапазон) Y в соответствии с оцифровкой;
5. Задать значения оси (диапазон) Х таким образом, чтобы Хмин было равно минимальному значению на рисунке (30), а Хмакс подобрать таким образом, чтобы совпали значения рисок (40=40, 50=50, 60=60, 70=70).
Шаг 2. Построение правого графика (красный график, красный ось, красный данные).
1. Построить точечный график по исходным данным, причём минимум Х заложить равным минимуму по второй оси (0);
2. Указать построение по вспомогательным осям;
3. Задать значения вспомогательной оси (диапазон) Y в соответствии с оцифровкой;
4. Задать значения оси (диапазон) Х таким образом, чтобы Хмакс было равно максимальному значению по второй оси рисунка, а Хмин подбрать таким образом, чтобы начало второго графика легло на минимум второй оси Х рисунка.
Шаг 3. Убрать отображение подписей осей, сетки и т.д. Настроить цвета линий.
============================
Для кого то это покажется элементарным, но я на своей практике не один раз ломал голову как выполнить графическое оформление поиска решения. Базовыми знаниями поделился. Всё дальнейшее зависит от вас. Будут вопросы - помогу по мере сил.
Пожалуй на этом закончим и серию Excel. Долгая дорога оцифровки. Всё обещанное показал, а именно:
1. Теория
3. Апроксимация простых графиков
4. Макрос по созданию макросов простых функций
5. Создание макроса функции двух аргументов
7. Макрос по созданию макросов на основе кусочной интерполяции
8. Обратная функция или поиск корней
9. Отображение поиска решения (данный пост).
Иногда требуется произвести определение значения аргумента (X) в зависимости от известного значения функции (Y).
Ввиду особенностей оцифровки есть два основных варианта решения данного вопроса
Вариант 1. Если сохранены данные "снятия точек", и зависимость монотонна как на рисунке выше, то самым простым решением является поменять снятые точки Х и Y и создать новый макрос.
Вариант 2. Решение задачи Y(x) - Yзад = 0, что так же может выполняться разными способами.
Существует множество численных решение данной задачи: метод половинного деления, метод Ньютона, метод... в общем методов достаточно много, и все несложно реализуются, например вот макрос поиска решения Y_ot_X(x) - Yзад = eps. методом половинного деления Где Y_ot_X(x) - известный макрос расчёта простой функции, а eps - точность поиска решения.
Public Function X_po_Y_polovin(Y As Single) As Single
Dim Xmin As Single: Xmin = 0 ' Минимальная граница поиска
Dim Xmax As Single: Xmax = 350 ' Максимальная граница поиска
Dim Xisk As Single ' Переменное значение искомого Х
Dim dX As Single: dX = 0.00001 ' Точность поиска по X
Dim dY As Single: dY = 0.00001 ' Точность поиска по Y
Do While (Xmax - Xmin) > dX
Xisk = (Xmax + Xmin) / 2
If Abs(Y_ot_X(Xisk) - Y) < dY Then Exit Do
If (Y_ot_X(Xmin) - Y) * (Y_ot_X(Xisk) - Y) < 0 Then
Xmax = Xisk
Else
Xmin = Xisk
End If
Loop
X_po_Y_polovin = Xisk
End Function
Казалось бы, для функции зависимой от двух параметров не сложно написать аналогичную функцию (и это так). Только вот работать она (обратная функция через половинное деление или фактически любого другого численного метода) будет не всегда.
Вот так выглядит макрос выполняющий поиск решения при помощи метода половинного деления для функции 2-х аргументов.
' НТД ТЭЦ12 ПТ9 Диаграмма режимов 2ст.режим нижний график
' Определение Nф по N и Qт
Public Function НТД_ТЭЦ12_ПТ9_ПТ2_QпМАКС(Nф As Single, Qт As Single) As Single
Dim Xmin As Single: Xmin = 0# ' Минимальная граница поиска
Dim Xmax As Single: Xmax = 200# ' Максимальная граница поиска
Dim Xisk As Single ' Переменное значение искомого Х
Dim dX As Single: dX = 0.001 ' Точность поиска по X
Dim dY As Single: dY = 0.001 ' Точность поиска по Y
' Обязательно проверка выхода за границы.
If Qт > НТД_ТЭЦ12_ПТ9_ПТ2_GтпоNфQпмакс(Nф, 0) Then
НТД_ТЭЦ12_ПТ9_ПТ2_QпМАКС = 0
Else
Do While (Xmax - Xmin) > dX
Xisk = (Xmax + Xmin) / 2
If Abs(НТД_ТЭЦ12_ПТ9_ПТ2_GтпоNфQпмакс(Nф, Xisk) - Qт) < dY Then Exit Do
If (НТД_ТЭЦ12_ПТ9_ПТ2_GтпоNфQпмакс(Nф, Xmin) - Qт) * (НТД_ТЭЦ12_ПТ9_ПТ2_GтпоNфQпмакс(Nф, Xisk) - Qт) < 0 Then
Xmax = Xisk
Else
Xmin = Xisk
End If
НТД_ТЭЦ12_ПТ9_ПТ2_QпМАКС = Xisk
Loop
End If
End Function
Рассмотрим диаграмму зависимости от двух аргументов Qт = f(Nт, Qтmax). И наша задача определить значение Qтmax при известных Qт и Nт. Макрос поиска с помощью половинного деления приведён выше.
И вот тут начинается особенность оцифровки - мы можем с уверенностью сказать и проверить значение функции только в области представленного графика. Т.е. проще говоря - данных о значениях при Qпmax = 120 и Nт < 39 у нас нет. В этой зоне имеет место экстраполяция данных, и как поведёт функция при экстраполяции зависит от того как мы провели оцифровку. В данном случае (данной номограммы) особого влияния может и не будет, но есть варианты, что экстраполированная с помощью полинома функция искривиться и значение при Qпmax = 120 и Nт = 20 будет больше чем при Qпmax = 0 и Nт = 20. Т.е. и метод половинного деления отработает не верно.
Поэтому два простых правила:
1. При проведении оцифровки внимательно относитесь к экстраполяции. В идеале - кусочная интерполяция с использованием линейной интерполяции для начала и окончания графика.
2. Если расчётов мало - используйте метод перебора.
Public Function X_po_Y_perebor(Y As Single) As Single
Dim Xmin As Single: Xmin = 0 ' Минимальная граница поиска
Dim Xmax As Single: Xmax = 350 ' Максимальная граница поиска
Dim dX As Single: dX = 0.001 ' Шаг поиска
Dim dY As Single: dY = 0.00001 ' Точность поиска
Dim Xisk As Single ' Переменное значение искомого Х
For Xisk = Xmin To Xmax Step dX
If Abs(Y_ot_X(Xisk) - Y) < dY Then
X_po_Y_perebor = Xisk
Exit For
Else
X_po_Y_perebor = 0
End If
Next Xisk
End Function
Пример перебора для функции двух аргументов
fun_TEC25_PT60_Prez_G0poGsd(N, i) - известная ф-я поиска Gо по N и Gsd
G0 - известно
N - известно
Gsd - требуется найти
For i = 0 To 300 Step 0.01 - ищу от 0 до 300 с шагом 0,01
< 0.1 - достаточная (для примера) точность поиска.
Public Function fun_TEC25_PT60_Prez_Gsd_poG0N(G0 As Single, N As Single) As Single
Dim i As Single
fun_TEC25_PT60_Prez_Gsd_poG0N = 0 'Если решение не будет найдено - будет выведен 0
For i = 0 To 300 Step 0.01
If Abs(fun_TEC25_PT60_Prez_G0poGsd(N, i) - G0) < 0.1 Then
fun_TEC25_PT60_Prez_Gsd_poG0N = i
Exit For
End If
Next i
End Function
Поиск всех корней уравнения, заданного таблично
Отдельной темой является поиск решения для функции заданной таблично. Для этого не обязательно переводить эту функцию в макрос. Вариант решения ниже:
Option Base 1 ' Иначе смотреть корень с второго элемента
Function РешенУравн(МассивX, МассивY)
' Возвращает корень(корни) уравнения Y(X) = 0
' МассивX - монотонно или возрастает, или убывает
Dim Xs() As Double, Ys() As Double, XEs() As Double, Num, N As Long, M As Long, K As Long
МассивX = МассивX
МассивY = МассивY
ReDim Xs(2 ^ 10), Ys(2 ^ 10), XEs(2 ^ 8)
For Each Num In МассивX
K = K + 1: Xs(K) = Num
Next
N = K: K = 0
For Each Num In МассивY
K = K + 1: Ys(K) = Num
Next
If K <> N Then Exit Function' если длина МассивY <> длине МассивX
For K = 1 To N - 1
If Ys(K) = 0 Then
M = M + 1: XEs(M) = Xs(K)
Else
If Ys(K) * Ys(K + 1) < 0 Then
M = M + 1
XEs(M) = (Ys(K) * Xs(K + 1) - Xs(K) * Ys(K + 1)) / _
(Ys(K) - Ys(K + 1))
End If
End If
Next
If K = N Then
If Ys(N) = 0 Then
M = M + 1: XEs(M) = Xs(N)
End If
End If
If M = 1 Then
РешенУравн = XEs(1)
ElseIf M > 1 Then
ReDim Preserve XEs(M) ' если корней несколько - массив
РешенУравн = WorksheetFunction.Transpose(XEs)
Else ' корней в диапазоне МассивX нет
РешенУравн = CVErr(xlErrNA)
End If
Exit Function
End Function 'РешенУравн'
Макрос не мой. Взят из открытых источников на просторах интернета, но первоисточник у меня не сохранился (к моему огорчению - стараюсь всегда указывать авторов).
=======================
dixi
За сим тему оцифровки считаю на 80% закрытой. Всегда есть то, что относится к конкретной работе, и не всегда подлежит огласке. Если будут вопросы - постараюсь ответить. В меру знаний естественно.
Для тех кто считает что "не надо изобретать велосипед" - прошу привести примеры подобного в свободном бесплатном доступе. Я знаю (встречался) с платными надстройками, о бесплатных не в курсе. Буду рад расширить кругозор.
Тех кто считает что "надо пользоваться пайтоном/матлабом/маткадом/... Ибо там всё есть и проще" хочу огорчить - придя на работу у Вас не всегда есть эти мат.пакеты. Вы не всегда имеете возможность их установки (хоть лицензия, хоть пиратка, хоть триал). Просто запрет компании. И при этом задача должна быть решена. И решена ни один или два раза. Вы можете распечатать и ползать с карандашом и линейкой по диаграммам. А можете перевести в цифру. Как показала практика - оцифровка вполне реализуется, и на 100% работа может быть выполнена в Excel. Без дополнительных надстроек. И даже если Вы решили задачу на своём, личном компе - остаётся вопрос передачи расчёта заказчику, или в вышестоящую инстанцию.
Ну а в следующий раз будем строить стрелочки на рисунках :)
По аналогии с Excel. Долгая дорога оцифровки. Часть 4. Макрос по созданию макросов апроксимации простых графиков полиномом и Excel. Долгая дорога оцифровки. Часть 6. Кусочная интерполяция не сложно выполняется макрос по созданию макросов оцифровки простых графиков с использованием кусочной интерполяции.
Описание вводимых данных аналогично ранее изложенному.
Если ещё немного развить тему, то и макрос создания макросов функции с двумя аргументами не проблема:
Отличием от вводимых ранее данных является требование указания критериев через точку с запятой.
Основное нововведение - определение количества графиков. Если вспомните ещё в Excel. Долгая дорога оцифровки. Часть 2. Забираем данные с листа я писал, что что "снятие точек производить от меньшего Х к большему. При наличии диаграммы зависимости от двух аргументов типаY(X1, X2) начиная с графика меньшего Х2. С обязательным условием - каждая следующая линия должна начинаться с Х меньшего, чем закончилась предыдущая.". И теперь можно этим воспользоваться - определить количество переходов на новую линию по уменьшению Х по сравнению с предыдущим.
For i = 2 To xVal.Count
If i = xVal.Count Then
Nkon(Ndiap) = i
End If
If xVal.Rows(i) < xVal.Rows(i - 1) Then
Nkon(Ndiap) = i - 1
Ndiap = Ndiap + 1
Nna4(Ndiap) = i
End If
Next i
Ну а дальше просто - перебираем поочерёдно все диапазоны, для каждого определяем уравнение апроксимации...
Результирующий макрос будет иметь вид:
' Поправки Сербия Панчево Страница 34 из 77 Нижний рисунок
Public Function ТЭХ_ПТ80_Рис3(ByRef Go As Single, ByRef CkH As Single) As Single
Dim krit_kriv As Variant
krit_kriv = array(2.96,3.06,3.15)
Dim kriv As Variant
kriv = Array(-0.00271242 * Go + 0.100817, _
-0.00252906 * Go + 0.230858, _
0.000276671 * Go ^ 2 -0.203078 * Go + 31.5862)
ТЭХ_ПТ80_Рис3= kus_interp(krit_kriv, kriv, CkH, 2)
End Function
Не забываем удалять кавычки в начале и конце макроса при копировании в модуль.
Давайте так, чтобы не утомлять читателя выкопировкой текстовок макросов - выкладываю сие для свободной скачки/использования/модернизации
Если возникнут вопросы как сие работает, распишу. Если у кого то что то не заработает - обращайтесь, посмотрю.
В программе есть не описанный мной макрос кубического сплайна, но т.к. автор не я, и макрос выложен в общественный доступ, для ознакомления с остальными сплайнами переходите по приведённой в макросе ссылке
За сим тему с оцифровкой считаю закрытой. Все базовые функции показал. С помощью данных функций, а так-же их комбинаций и расширений можно сделать автоматическую оцифровку совершенно разнообразных конфигураций диаграмм.
Например диаграмма с несколькими независимыми графиками типа такой. Можно либо сделать 3 независимых макроса, либо один с выбором графика.
С помощью автоматического создания макросов
Позволит получить (текстовка от графика отличного от представленного выше рисунка)
' ТЭХ ПТ80 Рис.3 Давление в отборах при конденсационном режиме [МПа]
Public Function ТЭХ_ПТ80_Рис3(ByRef Go As Single, ByRef Название_графика As Variant) As Variant
Dim krit_graph As Variant
krit_graph = array(1,2,3)
Select Case Название_графика
Case krit_graph(0)
ТЭХ_ПТ80_Рис3 = -0.0027124 * Go ^ 1 + 0.10082
Case krit_graph(1)
ТЭХ_ПТ80_Рис3 = -0.0025397 * Go ^ 1 + 0.23509
Case krit_graph(2)
ТЭХ_ПТ80_Рис3 = -0.0026659 * Go ^ 1 + 0.4529
Case Else
ТЭХ_ПТ80_Рис3 = 999999999999999
End Select
End Function
При желании указывать название графика правится krit_graph = array("Go","Qo","qt").
Ну и гораздо более сложноподчинённые, например что реализовано у меня:
Создание макроса для варианта когда критерий зависит от своего критерияДиаграммы режимов ПТ типа ПТ-80
Диаграммы режимов типа Т-250
Нормативной температуры сетевого подогревателя.
Все вышеперечисленные сложные диаграммы можно разбить на простые, и сделать в ручном режиме с помощью тех программ создания макросов что я дал. А можно потратить пару вечеров и создать удобный инструмент под свои задачи.
Из того на что стоит обратить внимание, или маленькие лайфхаки:
1. Не всегда есть разметка осей. Например на диаграмме на последнем скрине вертикальная ось не размечена. Но она в данном случае не нужно. Важно иметь одинаковое значение для левого и правого графиков. Как правило я принимаю в качестве минимального значения оси - 0, в качестве максимального - число клеток (например 12-ть).
2. Внимание! Ось Х не обязательно горизонтальная при "снятии точек"! Например на диаграмме на последнем скрине для правого графика удобно взять в качестве оси Х вертикальную ось а в качестве Y - горизонтальную. Тогда результат обработки левой номограммы будет сразу выступать в качестве аргумента для правой номограммы.
3. Есть варианты оцифровки, когда лучше привязываться не к значениям осей, а к клеточкам :) Да, звучит дико, но иногда проще внести пересчёт внутри макроса, чем реализовать оцифровку по данным осей. Например диаграмма ниже - обратите внимание, что вертикальная ось не обозначена, зато горизонтальная в левой диаграмме разбита на 3 участка с разным масштабом.
Упд. Вспомнил ещё про важную часть - обратные функции. Т.е. есть макрос (готовый!), который по известным Х1, Х2... находит Y. Иногда требуется с использованием данного макроса и известных Y и X1 найти X2... Но об этом в следующий раз. А то и так пост разросся.
Ну теперь пора перейти именно к интерполяции исходных данных. Итак, я напомню - у нас был лист с распечатанным графиком, мы его отсканировали, получили набор точек ХY и... имеем вот такую (в лучшем случае) картину (см.первый скрин). Т.е. по данному набору точек невозможно сделать корректную апроксимацию полиномом.
Выходом из данной ситуации является разбиение данных на несколько частей, в данном случае 2 с общей точкой Do=428, создание кусучнозаданной функции (ЕСЛИ меньше 428 одна функция, если больше - вторая функция). Но так в данном случае, а если надо сделать два, три...и больше разбиений? Кропотливая работа. Но зачем, если можно заставить Excel в автоматическом режиме выбирать малое количество точек и проводить через них интерполяционную функцию.
Отчасти кусочную интерполяцию показывал в прошлом посте серии ( Excel. Долгая дорога оцифровки. Часть 5. Создание пользовательской функции для двух аргументов. Ручной вариант ) при поиске решения между заданных критериев.
Как простые варианты рассмотрим кусочную интерполяцию по двум и по четырём точкам для заданных ниже данных.
Допустим нужно определить значение Y при X = 2.5.
При кусочной интерполяции по двум точкам используются две ближайшие заданные точки к X = 2.5. , т.е. 2 и 3, через данные точки провидится линия,и по ней находится Y при X = 2.5..
При кусочной интерполяции по четырём точкам используются две ближайшие заданные точки к X = 2.5. справа и две две ближайшие заданные точки к X = 2.5. слева, т.е. 1 и 2 и 3 и 4, через данные точки провидится кривая (полином 3-й степени),и по ней находится Y при X = 2.5.
Это справедливо для данных за 2-й и перед предпоследней известной точкой. Для данных отрезков и для экстраполяции использую линейную интерполяцию (по 2-м точкам).
Как видно использование кусочной интерполяции по 4-м точкам (голубая линия)немного сглаживает итоговую функцию, что позволяет снимать при оцифровке чуть меньше точек :) .
Вообще правило такое, в зависимости от вида графика:
Ну и собственно с помощью чего сие выполняется:
Макрос кусочной интерполяции при использовании данных с листа
======
' Интерполяция по 2-м, 3-м или 4-м ближайшим (до и после) к заданной (Xisk) точке
' В подпрограмму передаются все заданные точки
' Интерполяция происходит косочно, по количеству заданных точек с учётом расположения заданного Х
' Данные из листа Excel.
Public Function kus_interp_Ex(Xt As Range, Yt As Range, Xisk As Single, Optional ByVal toch As Integer = 2) As Variant
Dim i As Long
Dim xd() As Double
Dim yd() As Double
Dim cd() As Double
' toch - указание поиска решения с использованием количества точек (2, 3, 4).
Select Case toch
Case 2 ' Уравнение а·х+b
kus_interp_Ex = linterp(Xt.Rows(Xt.Count - 1), Xt.Rows(Xt.Count), Yt.Rows(Xt.Count - 1), Yt.Rows(Xt.Count), Xisk)
For i = 1 To Xt.Count - 1
If Xisk < Xt.Rows(i + 1) Then
kus_interp_Ex = linterp(Xt.Rows(i), Xt.Rows(i + 1), Yt.Rows(i), Yt.Rows(i + 1), Xisk)
Exit For
End If
Next i
Case 3 ' Уравнение а·х^2+b·x+c Интерполяция по принципу х1 Х х2 х3
kus_interp_Ex = kubterp(Xt.Rows(Xt.Count - 2), Xt.Rows(Xt.Count - 1), Xt.Rows(Xt.Count), _
Yt.Rows(Xt.Count - 2), Yt.Rows(Xt.Count - 1), Yt.Rows(Xt.Count), Xisk)
For i = 1 To Xt.Count - 2
If Xisk < Xt.Rows(i + 1) Then
kus_interp_Ex = kubterp(Xt.Rows(i), Xt.Rows(i + 1), Xt.Rows(i + 2), _
Yt.Rows(i), Yt.Rows(i + 1), Yt.Rows(i + 2), Xisk)
Exit For
End If
Next i
Case 4 ' Уравнение а·х^3+b·x^2+c·x+d Интерполяция по принципу х1 х2 X х3 x4
ReDim xd(1 To 4) As Double
ReDim yd(1 To 4) As Double
If Xisk < Xt.Rows(2) Then ' Экстраполяция ДО и интерполяция ДО второй известной точки - линейна
kus_interp_Ex = linterp(Xt.Rows(1), Xt.Rows(2), Yt.Rows(1), Yt.Rows(2), Xisk)
Else
If Xisk >= Xt.Rows(Xt.Count - 1) Then ' Экстраполяция ЗА и интерполяция ПОСЛЕ второй известной точки - линейна
kus_interp_Ex = linterp(Xt.Rows(Xt.Count - 1), Xt.Rows(Xt.Count), Yt.Rows(Xt.Count - 1), Yt.Rows(Xt.Count), Xisk)
Else ' Между ними считаю по интерполяции полиномом с расположением заданного икса между двух пар точек
For i = 3 To Xt.Count - 1
If Xisk < Xt.Rows(i) Then
xd(1) = Xt.Rows(i - 2): xd(2) = Xt.Rows(i - 1): xd(3) = Xt.Rows(i): xd(4) = Xt.Rows(i + 1)
yd(1) = Yt.Rows(i - 2): yd(2) = Yt.Rows(i - 1): yd(3) = Yt.Rows(i): yd(4) = Yt.Rows(i + 1)
Linia_trenda yd, xd, 3, cd
kus_interp_Ex = cd(1) * Xisk ^ 3 + cd(2) * Xisk ^ 2 + cd(3) * Xisk ^ 1 + cd(4)
Exit For
End If
Next i
End If
End If
Case Else
End Select
End Function
======Входные данные:
Xt - Столбец исходных Х
Yt - Столбец исходных Y
Xisk - X при котором требуется определить Y
toch - количество используемых точек при интерполяции.
Наблюдательный заметит, что в макросе присутствует и интерполяция с использованием 3-х точек. (0_о)
Дополнительная функция, требуемая для макроса кусочной интерполяции - определение коэффициентов полинома линии тренда:
======
' Проведение интерполяции с использованием функционала Excel
' На выходе - коэффициенты полинома. Число точек должно быть минимум на одну больше, чем степень полинома.
' Данные берутся из программы
Public Sub Linia_trenda(ByRef Y() As Double, ByRef x() As Double, ByVal PolyStep As Integer, ByRef c() As Double, Optional ByRef r2 As Double)
Dim stepen As Long
' Ввожу проверку не превышения степени массива
If (UBound(Y) - LBound(Y) - 1) < PolyStep Then
stepen = UBound(Y) - LBound(Y)
Else
stepen = PolyStep
End If
' Объявляю переменные, создаю матрицы под размер данных и степень полинома.
Dim X1() As Double, Y1() As Double
ReDim X1(LBound(Y) To UBound(Y), 1 To stepen) As Double
ReDim Y1(LBound(Y) To UBound(Y), 1 To 1) As Double
ReDim c(1 To stepen + 1) As Double
' Заполню массив Х в соответствии со степенью уравнения.
For i = LBound(x) To UBound(x)
Y1(i, 1) = Y(i)
X1(i, 1) = x(i)
For N = 2 To stepen
X1(i, N) = X1(i, 1) ^ N
Next N
Next i
' Нахожу уравнение.
Dim Coefs As Variant
Coefs = WorksheetFunction.LinEst(Y1, X1, True, True)
' Вытаскиваю коэффициенты полинома.
For i = 1 To stepen + 1
c(i) = Coefs(1, i)
Next i
' Вытаскиваю величину достоверности апроксимации.
r2 = Coefs(3, 1)
End Sub
======Макрос linterp был представлен в прошлый раз.
Одним из замечательных применений кусочной интерполяции является возможность автоматического создания макросов функций без проблем с невозможностью достоверной апроксимации исходных данных вот в таком виде:
' Поправки Сербия Панчево Страница 39 из 77
Public Function ТЭХ_ПТ80_Рис3(ByRef Go As Single) As Variant
Dim Xt As Variant
Dim Yt As Variant
Xt = Array(13.0042194092827, 13.4767932489451, 14.0675105485232)
Yt = Array(-6.38888888888889E-02, -6.38888888888889E-02, -0.06875)
ТЭХ_ПТ80_Рис3 = kus_interp(Xt, Yt, Go, 4, 2)
End Function
Учтите что kus_interp при использовании данных с листа и из макроса отличаются...
Но об этом в следующий раз.
===========================
Планы на будущее
1. Часть 7. Автоматическое создание макроса функции с использованием кусочной интерполяции.
2. Построим поиск решения.
3. Строим график функции.
Итак, если понятно как получить уравнение по имеющемуся графику одного аргумента, то перейдём к следующему этапу: Созданию макроса-функции по диаграмме двух аргументов или Y=f(X1,X2). Внешний вид таких диаграмм на скрине ниже.
Так повелось, что для удобства я называю второй аргумент критерием. Просто кроме зависимости от одного или двух аргументов существуют варианты зависимости от трёх и четырёх аргументов. У меня на практике доходило до пяти... Но для всех таких диаграмм была, как правило, общая ось Х.
В данном случае имеется зависимость от двух аргументов (Go, Qт). При этом для второго аргумента есть 10 критериев (Qт = 0, 20…180).
Решение происходит в два этапа:
Этап 1: для каждого критерия прописывается значение критерия и уравнение линии (не обязательно прямой как в данном примере), соответствующей критерию.
Этап 2: производится проверка перебором соотношения заданного критерия и имеющихся. Как только соотношение krit_kriv(i) Krit < krit_kriv(i + 1) выполняется, происходит поиск значения функции с использованием линейной (в данном случае) интерполяции (или просто через пропорцию) по точкам Y(Xзад, krit_kriv(i)) и Y(Xзад, krit_kriv(i+1.))
Т.е. например нужно определить значение при Gо=400 и Qт = 30. Соответственно я понимаю что искомое находится между критериями Qт = 20 и Qт = 40. Нахожу при данных критериях и при Go = 400 значения Gцнд. И через пропорцию определяю каким будет значение при Qт = 30.
Вспомогательный макрос нахождения значения через пропорцию. Требуется один такой макрос на все апроксимации.
=====
' Функция линейной интерполяции по двум точкам методом пропорции
' Необходимое условие X1 < X2
Public Function linterp(ByVal X1 As Single, ByVal X2 As Single, ByVal Y1 As Single, ByVal Y2 As Single, ByVal X As Single) As Single
If X2 = X1 Then X2 = X1 + X1 / 10000# ' Убираем совпадение иксов
linterp = Y2 - ((Y2 - Y1) / (X2 - X1)) * (X2 - X)
End Function
=====Ну и собственно макрос
' Программа является унифицированной для минимизации изменений.
Public Function ris_71(x As Single, Krit As Single) As Single
Dim kriv() As Single ' объявляем динамический массив
Dim krit_kriv() As Single ' объявляем динамический массив
Dim N_kriv As Integer, i As Integer ' объявляем тип числа уравнений
N_kriv = 10 ' ВВОДИМ число кривых
ReDim kriv(1 To N_kriv) ' Изменяем размер массива в соответствии с числом кривых.
ReDim krit_kriv(1 To N_kriv) ' Изменяем размер массива в соответствии с числом кривых
' требование - рост критериев должен быть по нарастающей. Критерий - это второй аргумент функции.
' ВВОДИМ критерии с первой по последнюю кривую в порядке возрастания
krit_kriv(1) = 0#
krit_kriv(2) = 20#
krit_kriv(3) = 40#
krit_kriv(4) = 60#
krit_kriv(5) = 80#
krit_kriv(6) = 100#
krit_kriv(7) = 120#
krit_kriv(8) = 140#
krit_kriv(9) = 160#
krit_kriv(10) = 180#
' ВВОДИМ уравнения кривых в соответствии с критериями
kriv(1) = 0.7324 * x - 1.576 ' соответствует krit_kriv(1) = 0# и т.д.
kriv(2) = 0.7343 * x - 30.41
kriv(3) = 0.7574 * x - 68.76
kriv(4) = 0.7536 * x - 102.2
kriv(5) = 0.756 * x - 142.9
kriv(6) = 0.7311 * x - 173.1
kriv(7) = 0.7582 * x - 221.6
kriv(8) = 0.7461 * x - 260.2
kriv(9) = 0.7894 * x - 323#
kriv(10) = 0.7798 * x - 357.2
If Krit > krit_kriv(N_kriv) Then
' предварительный расчёт результата если критерий больше максимального имеющегося
ris_71 = linterp(krit_kriv(N_kriv - 1), krit_kriv(N_kriv), _
kriv(N_kriv - 1), kriv(N_kriv), Krit)
Else
' проверка положения критерия относительно имеющихся кривых, и проведение линейной аппроксимации.
For i = 1 To N_kriv - 1
If Krit <= krit_kriv(i + 1) Then
ris_71 = linterp(krit_kriv(i), krit_kriv(i + 1), _
kriv(i), kriv(i + 1), Krit)
Exit For
End If
Next i
End If
End Function
Макрос описывающий наш пример приведён выше. Ввиду того, что приходилось делать большое количество таких апроксимаций, данный макрос оптимизирован для минимизации действий по его созданию.
Т.е. для нового графика потребуется
1. Заменить название. Внимание - менять по всему макросу.
2. Указать количество критериев.
3. Указать значения критериев
4. Указать уравнения описывающие критерии.
"Позабыты хлопоты, остановлен бег, Вкалывают роботы, счастлив человек!"(с)ПЭ
В этом посте я хотел бы показать, что ничего сложного в создании макроса, который бы выполнял рутинную работу по созданию макросов нет.
Всё базируется на трёх китах:
1. Унификация.
2. Результатом действия макроса может являться текст;
3. В текстовых переменных можно использовать спец символы:
3.1. Знак возврата каретки. vbCr она же символ Chr(13);
3.2. Знак перевода строки. vbLf она же символ Chr(10);
3.3. Символ объёдинения &.
Ну а теперь пройдём все шаги вместе.
В прошлом посте я говорил про макрос расчёта на основании построения тренда.
====
' Апроксимация полиномом для всего массива исходных данных
' В подпрограмму передаются все заданные точки и апроксимация ведётся по всем точкам!
' Данные из листа 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.]