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.
25.06.2023, 11:49 (Dieser Beitrag wurde zuletzt bearbeitet: 25.06.2023, 12:07 von Klaus-Dieter.)
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:
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
Viele Grüße
Klaus-Dieter Der Erfolg hat viele Väter, der Misserfolg ist ein Waisenkind Richard Cobden
Folgende(r) 1 Nutzer sagt Danke an Klaus-Dieter für diesen Beitrag:1 Nutzer sagt Danke an Klaus-Dieter für diesen Beitrag 28 • Asceroon
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.
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?
Viele Grüße
Klaus-Dieter Der Erfolg hat viele Väter, der Misserfolg ist ein Waisenkind Richard Cobden
25.06.2023, 17:16 (Dieser Beitrag wurde zuletzt bearbeitet: 25.06.2023, 17:17 von Klaus-Dieter.)
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.
Viele Grüße
Klaus-Dieter Der Erfolg hat viele Väter, der Misserfolg ist ein Waisenkind Richard Cobden
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
Excel VBA Problem
![[-]](https://www.clever-excel-forum.de/images/collapse.png)