Kalorien suchen und in Liste eintragen

Hallo zusammen ich habe mir eine Rezeptdatei gemacht und möchte nun die Kalorien zu den Zutaten aus einer Nährwerttabelle suchen und eintragen lassen.
Das funktioniert mit der untenstehenden Formel problemlos. Die Zutaten stehen in den Feldern D9:D 41, die Kalorien nach dem Suchvorgang in den Feldern H9:H41.
Ich habe habe den Code bis Zelle D41 wiederholt, kann man das irgendwie abkürzen, damit das übersichtlicher wird ? Vielen Dank
Sub Kalorien()
Dim i As Integer
For i = 4 To 1083
If Range("D9").Value Like Sheets(" Lebensmittel").Cells(i, 1) Then
Range("h9").Value = Sheets(" Lebensmittel").Cells(i, 4)
Else
If Range("D10").Value Like Sheets(" Lebensmittel").Cells(i, 1) Then
Range("h10").Value = Sheets(" Lebensmittel").Cells(i, 4)
Else
If Range("D11").Value Like Sheets(" Lebensmittel").Cells(i, 1) Then
Range("h11").Value = Sheets(" Lebensmittel").Cells(i, 4)
'und so weiter bis D41
End if
End if
End if
next i

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public Sub Kalorien() Dim lngRow As Long Dim objCell As Range For lngRow = 9 To 49 If Not IsEmpty(Cells(lngRow, 4).Value) Then Set objCell = Worksheets(" Lebensmittel").Columns(1).Find(What:= _ Cells(lngRow, 4).Value, LookIn:=xlValues, LookAt:=xlWhole, MathCase:=False) If Not objCell Is Nothing Then Cells(lngRow, 8).Value = objCell.Offset(0, 3).Value End If End If Next Set objCell = Nothing End Sub

Public Sub Kalorien() Dim lngRow As Long Dim objCell As Range With Application .EnableEvents = False .ScreenUpdating = False End With For lngRow = 10 To 42 If Not IsEmpty(Cells(lngRow, 4).Value) Then Set objCell = Worksheets(" Lebensmittel").Columns(1).Find(What:= _ Cells(lngRow, 4).Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) If Not objCell Is Nothing Then Cells(lngRow, 8).Value = objCell.Offset(0, 3).Value End If End If Next Set objCell = Nothing With Application .EnableEvents = True .ScreenUpdating = True End With End Sub

Sub Kalorien() Dim i As Integer, j As Long For i = 4 To 1083 For j = 9 To 41 If Cells(j, 4).Value Like Sheets(" Lebensmittel").Cells(i, 1) Then Cells(j, 8).Value = Sheets(" Lebensmittel").Cells(i, 4) End If Next j Next i End Sub

Beliebteste Forumthreads (12 Monate)

Kalorien suchen und in Liste eintragen

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

195 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kalorien suchen und in Liste eintragen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

195 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread