Hallo zusammen,
ich versuche gerade eine Excel Tabelle zu basteln und stehe vor einem Problem. Die Datei habe ich angehängt. In der Tabelle Einkaufsliste sollen die Zutaten für ein Rezept geschrieben werden, wenn in der Anzalhilfstabelle ein Wert von größer 0 steht. So habe ich das in VBA geschrieben. Allerdings werden die Zutaten immer eingetragen, egal welcher Wert in der Anzalhilfstabelle steht. Heißt also, dass die IF Prüfung immer zu True führt und nie zu False. Ich scheine etwas zu übersehen. Kann mir jemdand helfen?
Ich weiß, dass der Code nicht besonders ist, da ich ehrlicherweise keine Erfahrung mit VBA habe.
Viele Grüße
Hallo Asceroon,
mag sein, dass du keine Erfahrung mit VBA hast, leider gilt das offenbar auch für Excel. Dein Listenaufbau ist, freundlich formuliert, teilweise suboptimal. Besonders deine Anzahlhilfstabelle ist ein gravierendes Beispiel. Das würde ich so aufbauen:
Anzalhilfstabelle | A | B | C |
| 1 | Bestandteil | Mahlzeit | Menge |
| 2 | Porridge | Frühstück | 0 |
| 3 | Frühstücks Toast | Frühstück | 1 |
| 4 | Smoothie | Frühstück | 0 |
| 5 | Baked Oats | Frühstück | 0 |
| 6 | Toast Frühstück | Frühstück | 6 |
| 7 | Cheesburger mit Fries | Mittagessen | 0 |
| 8 | Mittags Wraps Avocado | Mittagessen | 2 |
| 9 | Maiswaffeln Abend | Mittagessen | 1 |
| 10 | Hähnchen mit Reis | Mittagessen | 3 |
| 11 | Salat | Mittagessen | 1 |
| 12 | Kartoffeln Quark | Abendessen | 0 |
| 13 | Zoodles Kochsahne | Abendessen | 0 |
| 14 | Potein Eis | Abendessen | 0 |
| 15 | Gigis Pasta | Abendessen | 0 |
| 16 | Rote Cream Pasta | Abendessen | 0 |
Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Was nun dein Makro betrifft, du betrachtest jeweils nur eine Zelle auf den Wert Null, das kann nicht funktionieren. Werde da mal was schreiben, bitte um Geduld, kommt gleich.
Hallo Asceroon,
hier das Makro:
Code:
Option Explicit ' erzwingt die Variablendeklaration
Sub Mengen()
' Variablen deklarieren (erforderlich)
Dim lngZeile As Long ' Schleifenzähler zur Prüfung und ggf. Übertrag der Daten
Dim lngAnz As Long ' Zeilenzähler für Zieltabelle
lngAnz = 2 ' Startwert auf 2 setzen
Cells.Delete Shift:=xlUp ' alte Inhalte löschen
For lngZeile = 2 To Tabelle4.Range("A" & Rows.Count).End(xlUp).Row ' durchlaufe alle gefüllten Zeilen der Liste
If Tabelle4.Cells(lngZeile, 3) > 0 Then ' wenn Listenwert größer als Null, dann ...
Tabelle5.Cells(lngAnz, 1) = Tabelle4.Cells(lngZeile, 1) ' ... Inhalte der ersten Spalte übertragen
Tabelle5.Cells(lngAnz, 2) = Tabelle4.Cells(lngZeile, 2) ' ... Inhalt der zweiten Spalte übertragen
Tabelle5.Cells(lngAnz, 3) = Tabelle4.Cells(lngZeile, 3) ' ... Inhalt der dritten Spalte übertragen
lngAnz = lngAnz + 1 ' ... Zeilenzähler plus 1
End If ' ... Ende Bedingung
Next lngZeile ' nächste Zeile aufrufen
Cells.EntireColumn.AutoFit ' Spalten auf optimale Breite einstellen
End Sub
Dazu der Hinweis, dass solche Makros in ein Standardmodul gehören, nicht in das Modul vom Tabellenblatt, so wie du das gemacht hast
Hallo Klaus-Dieter,
vielen Dank für die Hinweise. Ich habe nun deine VBA Zeilen in die Tabelle eingefügt und das ganze funktioniert auch.
Vielleicht habe ich mich auch missverständlich ausgedrückt. In der Tabelle Einkaufsliste sollten jedoch nicht die Mahlzeiten und die Anzahl stehen sondern die Bestandteile der Rezepte mit den entsprechenden Mengenangabe lt. Rezept.
Das Endresultat sollte so laufen, dass die Anzahl der Rezepte aus der Woche mit den Zutaten multipliziert wird und, falls es mehrere Rezepte mit gleichen Rezeptbestandteilen gibt, diese auf der Einkaufsliste zusammengefasst und die Mengen addiert werden.
Viele Grüße und vielen Dank für deine Hilfe.
Hallo Asceroon,
ich hatte schon vermutet, dass ich das nicht alles richtig interpretiert hatte. Was mir noch aufgefallen ist: es gibt da einmal Frühstücks Toast und auch Toast Frühstück, ist das das gleiche?
Hallo Klaus-Dieter,
nein, dass sind unterschiedliche Rezepte.
Viele Grüße
Hallo Asceroon,
bin dabei, das Makro nach deinen Anforderungen anzupassen. Leider ist die Rezeptliste unvollständig, was zu Laufzeitfehlern führt, die sich nicht gut abfangen lassen. Hast du eine vollständigere Liste zum Testen? Dann muss ich mir nichts ausdenken.
Hallo Klaus-Dieter,
ich setz mich ran. Sobald alle Rezepte eingetragen sind lade ich die Datei erneut hier hoch.
Viele Grüße und vielen herzlichen Dank.
Hallo Klaus-Dieter,
ich habe jetzt alle Rezepte inkl. der Zutaten erfasst.
Vielen Dank für deine Hilfe.
Hi,
teste mal
Code:
Sub x()
Dim Speisen() As Variant
Dim Liste() As Variant
'Mahlzeiten zusammenstellen aus Anzahlhilfstabelle
Call Mahlzeiten(Speisen)
'GesamtZutaten erfassen
For i = 1 To UBound(Speisen, 1)
ReDim Liste(0 To 3, 0 To 0)
If addZutaten(Liste, Speisen(i, 1), CLng(Speisen(i, 3))) Then
'Einkaufsliste erstellen
Call writeData(Speisen(i, 3) & " x " & Speisen(i, 1), Liste)
End If
Next
End Sub
Function Mahlzeiten(vIn)
Dim i As Long, z As Long
z = 0
With Worksheets("Anzalhilfstabelle")
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, 3) > 0 Then
ReDim Preserve vIn(0 To 2, 0 To z)
vIn(0, z) = .Cells(i, 1)
vIn(1, z) = .Cells(i, 2)
vIn(2, z) = .Cells(i, 3)
z = z + 1
End If
Next
vIn = Application.Transpose(vIn)
End With
End Function
Function addZutaten(Liste As Variant, strRezept As Variant, anz As Long) As Long
'Dim Liste() As Variant
Dim c As Range, z As Long
Dim firstaddress As String
z = 0
With Worksheets("Rezepte").Columns(2)
Set c = .Find(what:=strRezept, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstaddress = c.Address
Do
ReDim Preserve Liste(0 To 3, 0 To z)
Liste(0, z) = c.Offset(, 1)
Liste(1, z) = c.Offset(, 2) * anz
Liste(2, z) = c.Offset(, 3)
Set c = .FindNext(c)
z = z + 1
Loop While c.Address <> firstaddress
Else
Exit Function
End If
End With
Liste = Application.Transpose(Liste)
addZutaten = UBound(Liste)
End Function
Function writeData(Mahlzeit As Variant, vIn As Variant)
Dim i As Long
With Worksheets("Einkaufsliste")
lrow = .Cells(Rows.Count, 1).End(xlUp).Row + 2
Cells(lrow, 1) = Mahlzeit
For i = 1 To UBound(vIn, 1)
For j = 1 To UBound(vIn, 2)
.Cells(lrow + i, j) = vIn(i, j)
Next
Next
End With
End Function
VG Juvee
Hi
oder eine Formel und eine Pivot Tabelle. Kein VBA nötig.
Gruß Elex