4907
10-25-2016, 06:43 AM
Sub Combo()
n = Cells(Rows.Count, "A").End(xlUp).Row - 1
Dim step(), x(), y()
ReDim step(1 To n + 2)
ReDim x(1 To n)
ReDim y(1 To n)
'reads step sizes
For i = 1 To n
step(i) = Cells(i + 2, 1) - Cells(1 + 1, 1)
x(i) = Cells(i + 1, 1)
y(i) = Cells(1 + 1, 2)
Next i
For i = 1 To n
'Simposon's 3/8ths
If Abs(step(i) - step(i + 1)) < 0.0001 And Abs(step(i) - step(1 + 2)) < 0.0001 Then
a = Cells(i + 1, 1)
b = Cells(i + 4, 1)
sum = sum + (b - a) * (y(i) + 3 * y(i + 1) + 3 * y(1 + 2) + y(1 + 3)) / 8
i = i + 2
'Simpsons 1/3rd
ElseIf Abs((step(i)) - step(i + 1)) < 0.0001 Then
a = Cells(i + 1, 1)
b = Cells(i + 3, 1)
sum = sum + (b - a) * (y(i) + 4 * y(i + 1) + y(i + 2)) / 6
'Run-time error '9':Subscript out of range ^^^
i = i + 1
'Trapezoid
ElseIf step(i) > 0 Then
a = Cells(i + 1, 1)
b = Cells(i + 2, 1)
sum = sum + (b - a) * (y(i) + y(i + 1)) / 2
End If
Next i
Cells(3, "E") = sum
End Sub
n = Cells(Rows.Count, "A").End(xlUp).Row - 1
Dim step(), x(), y()
ReDim step(1 To n + 2)
ReDim x(1 To n)
ReDim y(1 To n)
'reads step sizes
For i = 1 To n
step(i) = Cells(i + 2, 1) - Cells(1 + 1, 1)
x(i) = Cells(i + 1, 1)
y(i) = Cells(1 + 1, 2)
Next i
For i = 1 To n
'Simposon's 3/8ths
If Abs(step(i) - step(i + 1)) < 0.0001 And Abs(step(i) - step(1 + 2)) < 0.0001 Then
a = Cells(i + 1, 1)
b = Cells(i + 4, 1)
sum = sum + (b - a) * (y(i) + 3 * y(i + 1) + 3 * y(1 + 2) + y(1 + 3)) / 8
i = i + 2
'Simpsons 1/3rd
ElseIf Abs((step(i)) - step(i + 1)) < 0.0001 Then
a = Cells(i + 1, 1)
b = Cells(i + 3, 1)
sum = sum + (b - a) * (y(i) + 4 * y(i + 1) + y(i + 2)) / 6
'Run-time error '9':Subscript out of range ^^^
i = i + 1
'Trapezoid
ElseIf step(i) > 0 Then
a = Cells(i + 1, 1)
b = Cells(i + 2, 1)
sum = sum + (b - a) * (y(i) + y(i + 1)) / 2
End If
Next i
Cells(3, "E") = sum
End Sub