Option
Explicit
Dim
wks
As
Worksheet
Public
Sub
main()
Set
wks = Worksheets(1)
Dim
i
As
Integer
, j
As
Integer
, intAnzahl
As
Integer
i = 1
Do
While
Not
wks.Cells(i, 1) = vbNullString
intAnzahl = (Round(wks.Cells(i, 1), 1) - Round(wks.Cells(i, 2), 1)) / 0.1
If
intAnzahl < 0
Then
intAnzahl = intAnzahl * -1
For
j = 1
To
intAnzahl
wks.Cells(i, 3) = wks.Cells(i, 3) + get_value(Round(wks.Cells(i, 1) + j / 10, 1))
Next
j
Else
For
j = 1
To
intAnzahl
wks.Cells(i, 3) = wks.Cells(i, 3) + get_value(Round(wks.Cells(i, 2) + j / 10, 1))
Next
j
End
If
intAnzahl = 0
i = i + 1
Loop
Set
wks =
Nothing
End
Sub
Private
Function
get_value(
ByVal
Wert
As
Double
)
As
Double
Dim
i
As
Integer
: i = 1
Do
While
Not
wks.Cells(i, 14) = vbNullString
If
wks.Cells(i, 14) = Wert
Then
get_value = wks.Cells(i, 15)
Exit
Function
Else
i = i + 1
End
If
Loop
get_value = 0
MsgBox
"Keinen Wert zu "
& Wert &
" gefunden.."
, vbInformation
End
Function