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

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

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

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

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

Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу.
Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста".
Название темы слишком короткое или не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте правила и заново правильно создайте тему.
 
Опции темы Поиск в этой теме
Старый 29.11.2008, 12:53   #1
SStone
Пользователь
 
Регистрация: 27.11.2008
Сообщений: 16
Вопрос Помогите разобраться со сплайн-интерполяцией!

Ребят, помогите разобраться...
Мне необходимо сделать кубическую сплайн интерполяцию по заданным Х и Y в Exel'e. Скачал алгоритм и написал небольшой код для вызова написанной функции! Но возникла проблема, что сплайн неадекватно строится...
т.е. для значений Х, например 1, 2, 3, 4, 5 и т.д. то сплайн строится нормально.
А если например задать последовательность 1, 3, 5.2, 6.5 и т.д. (т.е. отличную от изменения на 1), то сплайн рассчитывается неадекватно!
(в приклепленном файле выделенно желтым!)

Есть подозрения, что я неправильно обращаюсь к функции! Посмотрите plz...
Если у кого-то будет готовый код, буду очен признателен!

Заранее благодарю за помощь!
Вложения
Тип файла: zip SplineInt.zip (225.4 Кб, 32 просмотров)

Последний раз редактировалось SStone; 29.11.2008 в 15:31.
SStone вне форума
Старый 04.12.2008, 00:00   #2
SStone
Пользователь
 
Регистрация: 27.11.2008
Сообщений: 16
Стрелка

Ребят, помогите вызвать функцию из этого кода...
Код:
Function vbaSpline(a As Double, xrange As Object, yrange As Object, zrange As Object) As Double
'   On Error GoTo ErrorLabel
   vbaSpline = 0#
   Dim i%, j%, M%
   M = xrange.Rows.Count * xrange.Columns.Count
   If M < 1 Then
      Exit Function
   End If
   If M = 1 Then
      vbaSpline = yrange(1, 1)
      Exit Function
   End If
   If M <> yrange.Rows.Count * yrange.Columns.Count Or M <> zrange.Rows.Count * zrange.Columns.Count Then
'      MsgBox "error"
      Exit Function
   End If
   Dim x#(), y#(), z#()
   ReDim x(1 To M): ReDim y(1 To M): ReDim z(1 To M)
   For i = 1 To xrange.Rows.Count
      For j = 1 To xrange.Columns.Count
         x((i - 1) * xrange.Columns.Count + j) = xrange(i, j)
      Next j
   Next i
   For i = 1 To yrange.Rows.Count
      For j = 1 To yrange.Columns.Count
         y((i - 1) * yrange.Columns.Count + j) = yrange(i, j)
      Next j
   Next i
   For i = 1 To zrange.Rows.Count
      For j = 1 To zrange.Columns.Count
         z((i - 1) * zrange.Columns.Count + j) = zrange(i, j)
      Next j
   Next i
   If a <= x(1) Then
      vbaSpline = y(1) + z(1) * (a - x(1))
      Exit Function
   End If
   If a >= x(M) Then
      vbaSpline = y(M) + z(M) * (a - x(M))
      Exit Function
   End If
   Dim ij%, d#, e#, f#
   i = 1: j = M
   While j - i > 1
      ij = (i + j) / 2
      If a <= x(ij) Then
         j = ij
      Else
         i = ij
      End If
   Wend
   d = a - x(i)
   e = x(j) - x(i)
   f = (y(j) - y(i)) / e
   vbaSpline = y(i) + d * (z(i) + d * (3 * f - z(j) - 2 * z(i) - d * (2 * f - z(j) - z(i)) / e) / e)
Exit Function
ErrorLabel:
   MsgBox "error in vbaSpline"
   vbaSpline = 0#
End Function
Необходимо, чтобы X и Y перебирался из соответствующих столбцов, а в соседнии столбцы выводились значения Х с шагом разбиения и значением функции в данной точке!
Примерно также как в прикрепленном файле (см.выше)!
Буду очень признателен...
SStone вне форума
Закрытая тема


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите разобраться rainbow Паскаль, Turbo Pascal, PascalABC.NET 45 04.04.2009 20:46
Помогите разобраться Юля6ка Паскаль, Turbo Pascal, PascalABC.NET 5 01.10.2008 22:39
Помогите разобраться! SerSasha Помощь студентам 4 09.06.2008 10:00