|
Hallo,
hier mal eine Lösung mit Schleifen, sieht komplizierter aus, als es ist:
Option Explicit
Dim wks As Worksheet
Public Sub main()
Set wks = Worksheets(1) 'Index Tabellenblatt
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
Gruß
SJ
|