Добрый день! У меня возникла проблема с интерполяцией одномерного массива данных. Если значения находятся в обычных ячейках то код работает, а если в разных то выдает не понятно какой результат(значение функции лежит между нужными аргументами но отличается от нужного на +- 10-15%). Код привожу ниже. Прошу помочь исправить данный код или посоветовать другой. Проблему долго пытался решить своими силами - не вышло.
[vba]
Код
Option Explicit
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]
[p.s.] Заранее благодарен.[/p.s.] [moder]Что-то странное у Вас. Покажите в файле.
Добрый день! У меня возникла проблема с интерполяцией одномерного массива данных. Если значения находятся в обычных ячейках то код работает, а если в разных то выдает не понятно какой результат(значение функции лежит между нужными аргументами но отличается от нужного на +- 10-15%). Код привожу ниже. Прошу помочь исправить данный код или посоветовать другой. Проблему долго пытался решить своими силами - не вышло.
[vba]
Код
Option Explicit
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]
[p.s.] Заранее благодарен.[/p.s.] [moder]Что-то странное у Вас. Покажите в файле.Odesey
Odesey, Проблема в том, что у Вас в массиве, при объединённых ячейках, получаются некоторые строки пустые "" - принимают нулевые значения, поэтому и счёт идёт неверный. Я бы создавал массив отдельно и записывал данные в него по условию непустых ячеек: [vba]
Код
Function Interp(a As Range, Arng As Range, Krng As Range) As Single Dim al, ks, i As Integer, i1_n As Integer, i2_n As Integer Dim Arng1() As Single, Krng1() As Single Dim cel As Range For Each cel In Arng If cel <> "" Then i1_n = i1_n + 1 ReDim Preserve Arng1(i1_n) Arng1(i1_n) = cel End If Next cel For Each cel In Krng If cel <> "" Then i2_n = i2_n + 1 ReDim Preserve Krng1(i2_n) Krng1(i2_n) = cel End If Next cel Do i = i + 1 Loop While Arng1(i) < a.Value 'If i = 1 Then Exit Function If Arng1(i) = a.Value Then Interp = Krng1(i) Else Interp = (Krng1(i) - Krng1(i - 1)) / (Arng1(i) - Arng1(i - 1)) * _ (a.Value - Arng1(i - 1)) + Krng1(i - 1) End If End Function
[/vba]
Odesey, Проблема в том, что у Вас в массиве, при объединённых ячейках, получаются некоторые строки пустые "" - принимают нулевые значения, поэтому и счёт идёт неверный. Я бы создавал массив отдельно и записывал данные в него по условию непустых ячеек: [vba]
Код
Function Interp(a As Range, Arng As Range, Krng As Range) As Single Dim al, ks, i As Integer, i1_n As Integer, i2_n As Integer Dim Arng1() As Single, Krng1() As Single Dim cel As Range For Each cel In Arng If cel <> "" Then i1_n = i1_n + 1 ReDim Preserve Arng1(i1_n) Arng1(i1_n) = cel End If Next cel For Each cel In Krng If cel <> "" Then i2_n = i2_n + 1 ReDim Preserve Krng1(i2_n) Krng1(i2_n) = cel End If Next cel Do i = i + 1 Loop While Arng1(i) < a.Value 'If i = 1 Then Exit Function If Arng1(i) = a.Value Then Interp = Krng1(i) Else Interp = (Krng1(i) - Krng1(i - 1)) / (Arng1(i) - Arng1(i - 1)) * _ (a.Value - Arng1(i - 1)) + Krng1(i - 1) End If End Function