Добрый день. Возникла проблема при инженерном расчете в автоматизации процесса двумерной интерполяции. Макросами до этого не занимался:( Есть функция для линейной интерполяции (нашел на форуме), которую думаю можно немного подправить: [vba]
Код
Function Interp(a As Range, Arng As Range, Krng As Range) As Single Dim al, ks, i As Integer al = Arng.Value: ks = Krng.Value Do i = i + 1 Loop While al(i, 1) < a.Value 'If i = 1 Then Exit Function If al(i, 1) = a.Value Then Interp = ks(i, 1) Else Interp = (ks(i, 1) - ks(i - 1, 1)) / (al(i, 1) - al(i - 1, 1)) * _ (a.Value - al(i - 1, 1)) + ks(i - 1, 1) End If End Function
[/vba] Необходимо найти значение из таблицы при изменяющихся a и b (таблицу приложил). Заранее всех благодарю.
Добрый день. Возникла проблема при инженерном расчете в автоматизации процесса двумерной интерполяции. Макросами до этого не занимался:( Есть функция для линейной интерполяции (нашел на форуме), которую думаю можно немного подправить: [vba]
Код
Function Interp(a As Range, Arng As Range, Krng As Range) As Single Dim al, ks, i As Integer al = Arng.Value: ks = Krng.Value Do i = i + 1 Loop While al(i, 1) < a.Value 'If i = 1 Then Exit Function If al(i, 1) = a.Value Then Interp = ks(i, 1) Else Interp = (ks(i, 1) - ks(i - 1, 1)) / (al(i, 1) - al(i - 1, 1)) * _ (a.Value - al(i - 1, 1)) + ks(i - 1, 1) End If End Function
[/vba] Необходимо найти значение из таблицы при изменяющихся a и b (таблицу приложил). Заранее всех благодарю.Khorr
Function Interp(P1 As Single, P2 As Single) As Double Dim Arr Dim i As Long, j As Long Dim Z1 As Double, Z2 As Double Arr = Range("A2:F6") For i = 2 To 6 If P2 <= Arr(1, i) Then Exit For Next i For j = 2 To 6 If P1 <= Arr(j, 1) Then Exit For Next j Z1 = Arr(j - 1, i - 1) + (Arr(j - 1, i) - Arr(j - 1, i - 1)) * (P2 - Arr(1, i - 1)) / (Arr(1, i) - Arr(1, i - 1)) Z2 = Arr(j, i - 1) + (Arr(j, i) - Arr(j, i - 1)) * (P2 - Arr(1, i - 1)) / (Arr(1, i) - Arr(1, i - 1)) Interp = Z1 + (Z2 - Z1) * (P1 - Arr(j - 1, 1)) / (Arr(j, 1) - Arr(j - 1, 1)) End Function
Function Interp(P1 As Single, P2 As Single) As Double Dim Arr Dim i As Long, j As Long Dim Z1 As Double, Z2 As Double Arr = Range("A2:F6") For i = 2 To 6 If P2 <= Arr(1, i) Then Exit For Next i For j = 2 To 6 If P1 <= Arr(j, 1) Then Exit For Next j Z1 = Arr(j - 1, i - 1) + (Arr(j - 1, i) - Arr(j - 1, i - 1)) * (P2 - Arr(1, i - 1)) / (Arr(1, i) - Arr(1, i - 1)) Z2 = Arr(j, i - 1) + (Arr(j, i) - Arr(j, i - 1)) * (P2 - Arr(1, i - 1)) / (Arr(1, i) - Arr(1, i - 1)) Interp = Z1 + (Z2 - Z1) * (P1 - Arr(j - 1, 1)) / (Arr(j, 1) - Arr(j - 1, 1)) End Function
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
