Excel VBA Problem

[Asceroon]

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

[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:

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

[Asceroon]

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.

[Klaus-Dieter]

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?

[Asceroon]

Hallo Klaus-Dieter,

nein, dass sind unterschiedliche Rezepte.

Viele Grüße

[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.

[Asceroon]

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.

[juvee]

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

[Elex]

Hi

oder eine Formel und eine Pivot Tabelle. Kein VBA nötig.

Gruß Elex