Allergen-Liste (Buchstaben)

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Allergen-Liste (Buchstaben)
von: Debian
Geschrieben am: 05.10.2015 23:02:36

Hoi zäme
Folgendes Anliegen:
Ich hab eine Excelmappe für einen Gastrobetrieb erstellt, mit welcher das Inventar aufgenommen werden soll und gleichzeitig Rezepte kalkuliert werden können.
Seit Dezember 2014 müssen in allen EU-Staaten in allen Speisekarten 14 Allergene gekennzeichnet werden. Ich möchte jetzt in der Inventarliste bei den Lebensmitteln die allfällig enthaltenen Allergene mit den dafür vorgesehenen Buchstaben kennzeichnen (z. Bsp. E für Erdnüsse, G für Milch etc., es ist ein Bild in der Inventarliste, wo alle infrage kommenden Allergene ausgezeichnet sind). Ebenso gibt es noch zwei Spalten für "Vegetarisch" und "Vegan", dort sollen die jeweiligen Rohstoffe mit einem "x" gekennzeichnet werden, ob sie Vegan oder nur Vegetarisch sind. Wenn ein "x" bei "Vegan" steht, soll "Vegetarisch" automatisch mit markiert werden. Werden die entsprechenden Zutaten zu einem Rezept kombiniert und alle enthaltenen Zutaten sind vegan oder wenigstens vegetarisch, so soll das im Rezeptblatt in Zelle C13 auch als vegan oder zumindest als vegetarisch markiert werden. Das Gleiche soll für die Buchstaben für die Allergene passieren. Im Rezeptblatt möchte ich dann unter der Zutatenliste in Zelle C14 die Buchstaben für die Allergene anzeigen lassen (Schema: "Enthält G, E, l, P").

Da die Datei zum hier hochladen etwas zu gross ist, hier der Link zu Dropbox:
https://www.dropbox.com/s/2sw6k70vrzv3cl6/Inventar%20%2B%20Rezeptkalkulator%20Version%201.xlsm?dl=0
Habt ihr eine Idee, wie man das praktikabel umsetzen kann?
Für eure Tipps schon mal im Voraus vielen Dank
Gruss.
Debian

Bild

Betrifft: AW: Allergen-Liste (Buchstaben)
von: fcs
Geschrieben am: 06.10.2015 09:39:47
Hallo Debian,
übernimm per SVERWEIS in weiteren Spalten zu den Zutaten die Informationen zu Allergenen und Vegan/Vegetarisch. Die "x" bei vegan und vegetarisch werden dabei in einer Spalte zu "nein", "vegan" oder "vegetarisch" verarbeitet.
Für die Auswertung der Allergene sind weitere Hilfsspalten erforderlich, so das diese sortiert und ohne doppelte ausgegeben werden.
Leer-Rezept

 OPQRS
17Allergenvegetarisch/veganAllergeneVorhanden 
18 NeinAAA
19 NeinB A
20 veganCCA, C
21 veganD A, C
22CvegetarischE A, C
23A, CveganF A, C
24  G A, C
25  H A, C
26  K A, C
27  L A, C
28  M A, C
29  N A, C
30  O A, C
31  P A, C
32  R A, C
33  S A, C
34  T A, C


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Leer-Rezept

 OPQRS
16mit Formeln    
17Allergenvegetarisch/veganAllergeneVorhanden 
18 NeinAAA

Formeln der Tabelle
ZelleFormel
O18=WENN(ODER($C18="";$C18="-"); "";TEXT(SVERWEIS($C18;Inventar!$C:$G;3;FALSCH); ""))
P18=WENN(ODER($C18="";$C18="-"); "";WENN(SVERWEIS($C18;Inventar!$C:$G;5;FALSCH)="x";"vegan";WENN(SVERWEIS($C18;Inventar!$C:$G;4;FALSCH)="x";"vegetarisch";"Nein")))
R18=WENN(ISTFEHLER(VERGLEICH("*"&Q18&"*";$O$18:$O$35;0)); "";Q18)
S18=WENN(R18<>"";WENN(S17="";R18;S17 & ", "&R18); S17)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Die Formeln können nach unten kopiert werden.
Per Formel kannst du dann "vegan" oder "vegetarisch" direkt ermitteln und die Allergene aus der letzen Zeile der Hilfsspalten:
Leer-Rezept

 BC
14AllergeneA, C
15 ------

Formeln der Tabelle
ZelleFormel
C14=S34
C15=WENN(ZÄHLENWENN(P17:P38;"Nein")>0;"------";WENN(ZÄHLENWENN(P17:P38;"Vegetarisch")>0;"Vegetarisch";"Vegan" ))


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Die Allergene könnte man auch ohne Hilfsspalten per benutzerdefinierter VBA-Function ermitteln.
Dann gibt es aber Probleme, wenn das Blatt in eine andere Arbeitsmappe kopiert wird, da die Function dort nicht definiert ist.
Gruß
Franz

Bild

Betrifft: AW: Allergen-Liste (Buchstaben)
von: debian
Geschrieben am: 06.10.2015 11:23:18
Hallo und guten Morgen Franz
Cool, Dein Ansatz gefällt mir!
Die Allergene der einzelnen Zutaten werden bei Dir aber im Rezeptblatt (hier 'Leer-Rezept') erfasst, richtig? Gedacht ist es eigentlich so, das im Blatt 'Inventar' wie ein Datensatz pro Artikel/Rohstoff erfasst werden, der eine grobe Einordung (zum Beispiel 'Molkerei' enthält, dann den Artikelname (Milch), Artikelbeschreibung (Milch, pasteurisiert, 1 Liter Tetrapack), dann eben die Allergene, vegan/vegetarisch, Lieferant, Gebindepreis und Menge je Gebinde usw. enthält. Nach Spalte L ergeben sich bis auf die Rezepteinheit in Spalte N alle Angaben durch Formeln.
Mein Ansatz ist also der, das bei Auswahl der Zutaten in Spalte C im Rezeptblatt eben genau die benötigten Informationen aus dem Blatt 'Inventar' übernommen werden und im Rezeptblatt nur ausgewertet werden. Ich gebe also die Allergene ganz bewusst NICHT IM Rezeptblatt ein.
Das Rezeptblatt wird auch nicht in eine andere Mappe kopiert, es bleibt immer hier in der Mappe. Für den Export als einlzenes Rezeptblatt hab ich ein Makro, welches das aktuelle Blatt ohne Formeln, nur mit Werten und Formaten kopiert. Darüberhinaus sollen die Blätter allenfalls für den Rezepteordner der Küche ausgedruckt werden.
Wie sähe Dein Ansatz damit aus?
Vielen Dank schon mal.
Grüsse.
Debian

Bild

Betrifft: AW: Allergen-Liste (Buchstaben)
von: fcs
Geschrieben am: 06.10.2015 13:18:59
Hallo Debian,
die Allergene werden nicht im Rezeptblatt erfasst, sondern in Spalte N per Formel berechnet entsprechend der eingegebenen Zutat in Spalte C und ähnlich wie die Basispreise aus dem Blatt "Inventar" übernommen.
Diese Daten werden dann in den Hilfsspalten verarbeitet.
Wenn du mit folgender benutzerdefinierten Funktion arbeitest, dann kannst du auf die Spalten Q, R und S verzichten.
Die Formel für die Allergene wird dann zu:

=fncAllergene(O18:O35;C18:C35)

Der Bereich mit den Zutaten sorgt hierbei dafür, dass bei Eingaben von Zutaten die Allergene immer neu berechent werden. Theoretisch könnte man die Funktion auch so aufbauen, dass die Daten aus "Inventar" direkt verarbeitet werden. Dann müßte die Function aber immer die gesamte Inventarliste bei jeder Zutat abarbeiten, statt auf die von der SVERWEIS-Funktion schnell zur Verfügung gestellten Daten zuzugreifen.
Außerdem ist es für den Rezeptersteller ja ggf. interessant zu sehen, welche Zutaten im Rezept Allergene liefern.
Gruß
Franz
'allgemeines Modul "Modul_Allergen"
Option Explicit
Public Function fncAllergene(Allergene As Range, Zutaten As Range, Optional sSep As String = ",  _
") As String
    Dim objCol As New Collection
    Dim Zelle As Range
    Dim arrAllergene() As String, iJ As Integer
    Dim arrSplit As Variant, Pos As Integer
    Dim sErgebnis As String
    On Error GoTo Fehler
    
    For Each Zelle In Allergene
        If Trim(Zelle.Text) <> "" Then
            arrSplit = Split(Zelle.Text, ",")
            For Pos = LBound(arrSplit) To UBound(arrSplit)
                objCol.Add Trim(arrSplit(Pos)), Trim(arrSplit(Pos))
                iJ = iJ + 1
                ReDim Preserve arrAllergene(1 To iJ)
                arrAllergene(iJ) = Trim(arrSplit(Pos))
Fehler:
            Next
        End If
    Next
    If iJ > 0 Then
        sErgebnis = arrAllergene(1)
        If iJ > 1 Then
            Call Quicksort(Data:=arrAllergene, links:=1, rechts:=iJ)
            sErgebnis = arrAllergene(1)
            For Pos = 2 To iJ
                sErgebnis = sErgebnis & sSep & arrAllergene(iJ)
            Next
        End If
        fncAllergene = sErgebnis
    Else
        fncAllergene = "keine"
    End If
End Function
Public Function Quicksort(Data, links, rechts)
  'Sortieren einer einspaltigen Datenliste
  'links und rechts geben die Nummern der der Elemente an, die sortiert werden sollen
  'normalerweise nimmt man das 1. und letzte Element
    Dim Teiler As Long
    If rechts > links Then
        Teiler = Teile(Data, links, rechts)
        Call Quicksort(Data, links, Teiler - 1)
        Call Quicksort(Data, Teiler + 1, rechts)
    End If
End Function
Private Function Teile(Data, links, rechts)
    Dim Index As Long
    Dim i As Long
    Index = links
    For i = links To rechts - 1
        If Data(i) <= Data(rechts) Then
            Call Tausche(Data, Index, i)
            Index = Index + 1
        End If
    Next
    Call Tausche(Data, Index, rechts)
    Teile = Index
End Function
Private Sub Tausche(Data, i, j)
    Dim Temp
    Temp = Data(i)
    Data(i) = Data(j)
    Data(j) = Temp
End Sub
Gruß
Franz

Bild

Betrifft: AW: Allergen-Liste (Buchstaben)
von: Debian
Geschrieben am: 07.10.2015 14:28:00
Hallo Franz :-)
Meinst Du, Du könntest Deinen Vorschlag in meiner Tabelle umsetzen?
https://www.dropbox.com/s/2sw6k70vrzv3cl6/Inventar%20%2B%20Rezeptkalkulator%20Version%201.xlsm?dl=0
Die von Dir genannten Spalten verwirren mich grad etwas, denn N ist eine Einheitenspalte, Q, R, S sind für Einheiten, Erdgeschoss und Obergeschoss gedacht. Was bitte genau meinst Du also?
Grüsse.
Debian

Bild

Betrifft: AW: Allergen-Liste (Buchstaben)
von: fcs
Geschrieben am: 08.10.2015 14:44:33
Hallo Debian,
du musst meinen Vorschlag in das Blatt Leerrezept einbauen!!!!!! Nicht "Inventar".
Die Formeln in den Spalten O und P im Blatt Leerrezept holen Informationen aus dem Blatt "Inventar" - genau so, wie in den Spalten B und die Informationen zu Portionsgröße und Bruttopreisen per Formel geholt werden.
Diese Informationen muss man dann weiterverarbeiten.
Bei den Allergenen geht das in meiner Lösung über die Daten und Formeln in den Spalten Q bis S oder mit dem geposteten Makro.
Wenn diese Spalten stören beim Ausdruck, dann kannst du sie ja auch ausblenden.
Wie bereits angedeutet, kann man das Makro auch soweit erweitern, dass es die Daten in der Inventarliste direkt auswertet. Aber das geht dann auf Kosten der Rechengeschwindigkeit, weil langsames VBA schnelle Excelfunktionen ersetzt.
Wenn du die große VBA-Lösung suchst, dann verwende die folgenden VBA-Funktionen.
Gruß
Franz
Leer-Rezept

 BC
14AllergeneA,C
15 nur für Fleischesser

Formeln der Tabelle
ZelleFormel
C14=fncAllergene(C18:C35;Inventar!$C$2:$E$5000;3)
C15=fncVegetarischVegan(C18:C35;Inventar!$C$2:$G$5000;4;5;"X";"-";;;"nur für Fleischesser")


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
'allgemeines Modul "Modul_Allergen"
Option Explicit
Public Function fncAllergene(rngZutaten As Range, rngInventar, SpaAllergen As Long, _
    Optional strSep As String = ",", _
    Optional Fuellzeichen As String = "-") As String
    'rngZutaten= 1-spaltiger Zellbereich mit den Zutatten
    'rngInventar = Zellbereich mit den Zutaten in Spalte 1 _
                    und den Allergen-Kennbuchstaben in der Spalte SpaAllergen
    'SpaAllergen = Nummer der Spalte mit den Allergenen innerhalb von rngInventar
    'strSep = Trennzeichen zwischen Allergenen, wenn eine Zutat mehreren Allergene _
                    enthält
    'Fuellzeichen = Text, der in Zelle stehen kann, wenn keine Zutat eingetragen ist
    
    'Formelbeispiel: =fncAllergene(C18:C35;Inventar!$C$2:$E$5000;3) _
                     =fncAllergene(C18:C35;Inventar!$C$2:$E$5000;3; ","; "-")
    
    Dim Zeile As Variant, Zelle As Range
    Dim arrSplit As Variant
    Dim objCol As New Collection
    Dim strErgebnis As String
    
    On Error GoTo Fehler
    
    For Each Zelle In rngZutaten.Columns(1).Cells
        If Not (Trim(Zelle = "") Or Zelle.Text = Fuellzeichen) Then
            Zeile = Application.Match(Zelle.Text, rngInventar.Columns(1), 0)
            If IsNumeric(Zeile) Then
                With rngInventar.Cells(Zeile, SpaAllergen)
                If Trim(.Text) <> "" Then
                    If strErgebnis = "" Then
                        strErgebnis = Trim(.Text)
                    Else
                        strErgebnis = strErgebnis & strSep & Trim(.Text)
                    End If
                End If
                End With
            Else
                fncAllergene = "#NV"
                Exit Function
            End If
        End If
    Next Zelle
    If Trim(strErgebnis = "") Then
        fncAllergene = "-keine-"
    Else
        If InStr(1, strErgebnis, strSep) = 0 Then
            fncAllergene = Trim(strErgebnis)
        Else
            arrSplit = Split(strErgebnis, strSep)
            strErgebnis = ""
            For Zeile = LBound(arrSplit) To UBound(arrSplit)
                objCol.Add Trim(arrSplit(Zeile)), Trim(arrSplit(Zeile))
                If strErgebnis = "" Then
                    strErgebnis = Trim(arrSplit(Zeile))
                Else
                    strErgebnis = strErgebnis & strSep & Trim(arrSplit(Zeile))
                End If
Next_Zeile:
            Next Zeile
            If InStr(1, strErgebnis, strSep) = 0 Then
                fncAllergene = Trim(strErgebnis)
            Else
                arrSplit = Split(strErgebnis, strSep)
                Call Quicksort(arrSplit, LBound(arrSplit), UBound(arrSplit))
                arrSplit = Split(strErgebnis, strSep)
                strErgebnis = ""
                For Zeile = LBound(arrSplit) To UBound(arrSplit)
                    If strErgebnis = "" Then
                        strErgebnis = Trim(arrSplit(Zeile))
                    Else
                        strErgebnis = strErgebnis & strSep & Trim(arrSplit(Zeile))
                    End If
                Next
                fncAllergene = strErgebnis
            End If
        End If
    End If
Fehler:
    With Err
        Select Case .Number
            Case 0 'alle OK
            Case 457 'doppelter Key in Collection
                Resume Next_Zeile
            Case Else
'                MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
                        vbOKOnly, "Function: fncAllergene" ' nur zum Testen
                fncAllergene = "#FEHLER#"
        End Select
    End With
    
End Function
Public Function fncVegetarischVegan(rngZutaten As Range, rngInventar, _
    SpaVeg As Long, SpaVegan As Long, _
    Optional strMarker As String = "X", _
    Optional Fuellzeichen As String = "-", _
    Optional ErgebnisVegan As String = "vegan", _
    Optional ErgebnisVegetarisch As String = "vegetarisch", _
    Optional ErgebnisAnderes As String = "nicht vegetarisch") As String
    'rngZutaten   = 1-spaltiger Zellbereich mit den Zutatten
    'rngInventar  = Zellbereich mit den Zutaten in Spalte 1 _
                    und den Markierung für "vegetarisch" in der Spalte SpaVeg _
                    und der Markierung für "vegan" in der Spalte SpaVegan
    'SpaVeg       =  Nummer der Spalte mit Markierung für vegetarisch
    'SpaVegan     =  Nummer der Spalte mit Markierung für vegan
    'strMarker    =  Zeichen zur Markierung, ob eine Zutat vegan/vegetarisch ist
    'Fuellzeichen = Text, der in Zelle stehen kann, wenn keine Zutat eingetragen ist
    
    'Formelbeispiel:
        '=fncVegetarischVegan(C18:C35;Inventar!$C$2:$G$5000;4;5;"X";"-")
    
    
    Dim Zeile As Variant, Zelle As Range
    Dim strErgebnis As String
    
    On Error GoTo Fehler
    
    strErgebnis = ErgebnisVegan
    For Each Zelle In rngZutaten.Columns(1).Cells
        If Not (Trim(Zelle = "") Or Zelle.Text = Fuellzeichen) Then
            Zeile = Application.Match(Zelle.Text, _
                    rngInventar.Columns(1), 0)
            If IsNumeric(Zeile) Then
                With rngInventar.Cells(Zeile, SpaVegan)
                If UCase(Trim(.Text)) <> UCase(strMarker) Then
                    strErgebnis = ErgebnisVegetarisch
                    With rngInventar.Cells(Zeile, SpaVeg)
                        If UCase(Trim(.Text)) <> UCase(strMarker) Then
                            strErgebnis = ErgebnisAnderes
                            Exit For
                        End If
                    End With
                End If
                End With
            Else
                strErgebnis = "#NV"
                Exit For
            End If
        End If
    Next Zelle
    fncVegetarischVegan = strErgebnis
Fehler:
    With Err
        Select Case .Number
            Case 0 'alle OK
            Case Else
                MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
                        vbOKOnly, "Function: fncVegetarischVegan" ' nur zum Testen
                fncVegetarischVegan = "#FEHLER#"
        End Select
    End With
    
End Function
Public Function Quicksort(Data, links, rechts)
  'Sortieren einer einspaltigen Datenliste
  'links und rechts geben die Nummern der der Elemente an, die sortiert werden sollen
  'normalerweise nimmt man das 1. und letzte Element
    Dim Teiler As Long
    If rechts > links Then
        Teiler = Teile(Data, links, rechts)
        Call Quicksort(Data, links, Teiler - 1)
        Call Quicksort(Data, Teiler + 1, rechts)
    End If
End Function
Private Function Teile(Data, links, rechts)
    Dim Index As Long
    Dim i As Long
    Index = links
    For i = links To rechts - 1
        If Data(i) <= Data(rechts) Then
            Call Tausche(Data, Index, i)
            Index = Index + 1
        End If
    Next
    Call Tausche(Data, Index, rechts)
    Teile = Index
End Function
Private Sub Tausche(Data, i, j)
    Dim Temp
    Temp = Data(i)
    Data(i) = Data(j)
    Data(j) = Temp
End Sub


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Allergen-Liste (Buchstaben)"