Monatliche Essenbestellung aus Tabelle auslesen

[Daniel Albert]

Hallo,

jetzt kommt wieder mal alles auf einmal. Als Kassierer unserer Mittagsbetreuung e.V. habe ich ständig mit viel Hilfe in diesem Forum eine Excel Tabelle ständig erweitert damit wir Arbeitsabläufe beschleunigen können. Nun sind wir so groß gewachsen das wieder ein neues Problem aufgetreten ist. Wir hatten bis diesen Monat die Essenskosten an unseren Lieferanten erst zum Monatsende bezahlt nachdem wir bei den Eltern die Beiträge abggbeucht haben. Nun sind wir bei einer sehr hohen Summe die der Lieferant nicht für einen Monat vorstrecken kann. Da 2 Abrechnungen im Monat extrem viel Mehrarbeit auch für mich bedeuten möchte ich dies anders Lösen. Ich brauche eine Übersicht welche Kinder täglich am Nachmittag da sind, denn diese müssen am Essen teilnehmen. SOmit kann ich über einen Dauerauftrag den Beitrag schon om voraus abbuchen.

Die monatlichen Listen werden durch das Tabellenblatt "Vorlage" generiert. Ab Zelle "A574" steht diese zur Verfügung sollte aber über die Tabelle "aktive Mitgleider" automatisch befüllt werden. Dort ist immer aktuell im Bereich "AL5 bis AP70" die Tage angekreuzt wo das Kind am Essen teilnimmt.

Da aber in der MOnatsliste 4 wochen hinterlegt sind verstehe ich nicht wie ich dem System sagen kann es soll "Mo" aus Tabelle "AL5 bis AP70" mit Mo aus A574 eintragen werden aber 4x als X. Das X kann ich ja über Zählenwenn zusammenfassen und die Anzahl x 3,70 Essenbeitrag. Somit habe ich die monatliche Belastung.

Kann mir bitte jemand Helfen?

Gruß Daniel

[Gast 123]

Hallo Daniel,

anbei ein kleines Makro mit dem das Problem in ein paat Sekunden gelöst werden sollte. Bitte in ein Modul laden und ausprobieren.
Würde mich sehr freuen wenn es klappt.

mfg  Gast 123

Code:

Option Explicit      '20.10.2016  Gast 123   Clever Forum

'aktive Mitglieder
Const BstBer = "AL5:AP70"     'Essensbestellung
Const VlgBer = "A576:AG641"   'Vorlage Löschbereich
Const VlgAdr = "A576"         'Vorlage Anf-Adresse


Sub Essenliste_ausfüllen()
Dim AC As Object, v As Integer
Dim s As Integer, z As Integer
Dim AMt As Object, Vlg As Object
Set Vlg = Worksheets("Vorlage")
Set AMt = Worksheets("aktive Mitglieder")

'alte Liste löschen
Range(VlgBer).ClearContents

'Schleife in Spalte AL-AP nach x
For Each AC In AMt.Range(BstBer)
  If AC.Value <> Empty Then
     'Zeilen Nr fğr Vorlage ermitteln
     If AC.Row > v Then z = z + 1: v = AC.Row
     s = AC.Column - 34 'Spalten Nr (4=Mo)  AL=38
     
     'Kindername kopieren
     Kind = AMt.Cells(AC.Row, 3).Value
     Vlg.Range(VlgAdr).Cells(z, 1) = Kind
     
     '4 Wochen Essen Schleife
     For j = 0 To 3
        Vlg.Range(VlgAdr).Cells(z, s) = "x"
        s = s + 7
     Next j
     
     'Montag Korrektur in Spolte AF
     If AC.Column = 38 Then _
        Vlg.Range(VlgAdr).Cells(z, s) = "x"
  End If
Next AC
End Sub

[Fennek]

Hallo,

so als kleine Übung vor dem Wochenende:

Code:

Sub Kinder()
With Sheets("aktive Mitglieder")
For i = 5 To 70 'Schleife alle Kinder Blatt Aktive Mitglieder
   For j = 0 To 4 'Essensbestellung Sheet Aktive Spalte AL:Ap
       If .Cells(i, "AL").Offset(, j) = "x" Then
           WO = .Cells(3, "AL").Offset(, j)
           Debug.Print .Cells(i, "C"), WO
           Call Bestellungen(i, WO)
       End If
       
   Next j
Next i
End With
End Sub

Sub Bestellungen(ByVal i As Integer, ByVal WO As String)
With Sheets("November 2016")
Debug.Print "Nov: ", .Cells(i, "A").Offset(576 - 5).Value, Format(.Cells(575, "B"), "DDD")
   For j = 2 To 32
       If Format(.Cells(575, j), "DDD") = WO Then .Cells(i, j).Offset(576 - 5) = "x"
   Next j
End With
End Sub

Der Code ist "unausgegoren", das sheet "Nov" ist hart codiert, sollte aber einfach zu ändern sein.

mfg

(PS: ich schätze Gast 123, es soll wirklich kein Wettbewerb sein, aber im Moment waren andere Fragen "zu langweilig")

[snb]

Nur mit Arrays:

Code:

Sub M_snb()
  y = Weekday(DateSerial(2016, 11, 1), 2) - 1
  sn = Tabelle1.Cells(5, 38).Resize(70, 5)
  ReDim sp(1 To UBound(sn), 1 To 31)
    
  For j = 1 To UBound(sn)
    For jj = 1 To 5
      If LCase(sn(j, jj)) = "x" Then
        For jjj = 0 To 5
          If jj + 7 * jjj <= UBound(sp, 2) And jj - y > 0 Then sp(j, jj + 7 * jjj - y) = "x"
        Next
      End If
    Next
  Next
    
  Tabelle44.Cells(576, 2).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub

[Gast 123]

Hallo Fennek und Snb

ich freue mich das es drei Lösungen im Forum gibt, sehe es nicht als Konkurrenz an. Interessant ist das jeder von uns seine eigene Lösung anbietet und seinen eigenen Programmierstil hat. Warten wir ab wie Daniel zurecht kommt. Hauptsache es macht Spass Hilfe anzubieten. Wir werden ja nicht bezahlt, arbeiten völlig freiwillig. Haben keinen stressigen Chef! Nur einen Moderator, der sich nicht einmischt solange wir in Ruhe und ohne zu streiten Rat geben.
in diesem Sinne, ein frohes Schaffen für alle Beteiligten ......

mfg  Gast 123

[Daniel Albert]

Guten Morgen,

so ich habe gestern alle Codes in Module geladen und ausprobiert.

@Gast - leider funktioniert es nicht. Ich starte das Makro Essenliste_ausfüllen und bei Kinf bleibt er stehen - Fehler beim kompilieren - Variable nicht definiert. Wichtig wäre auch nicht die Vorlage zu verwenden sondern den Monat der gerade erstellt wurde. In "Aktive Mitglieder" wird ja der Monatswechsel gestartet und aus der Vorlage wird die neue Tabelle erstellt. Danach sollte die Befüllung des Essenplan ab A576 erfolgen.

Den Kindername müsste man nicht mehr erstellen der wird schon mit dem Makro !Userform_anzeigen erstellen. Also es geht nur um die Übernahme der angekreuzten Tage wo die Kinder an den Wochentagen am Essen teilnehmen sollen - Die Kreuze befinden sich in AL5:AP70 in der Liste aktive Mitglieder

@Fennek, dein Code funktioniert. Einzige wäre es müsste halt wie oben beschrieben direkt an der neu erstellten Monatstabelle angeknüpft werden. Da reicht doch deinen Punkt in Activesheet umzuwandeln oder nicht?

@snb - der Code funktioniert aber leider nur im November und am Ende schimpft er wegen Blattschutz - bei  Tabelle44.Cells(576, 2).Resize(UBound(sp), UBound(sp, 2)) = sp (Was macht dieser Code) -


Gruß Daniel

[snb]

Wenn man mit VBA arbeitet braucht man nie einen Blattschutz (iche verwende den auch nie). Wozu ein Blattschutz eines Blattes das man ändern muss ( ???).

Die Code anpassen für eine anderen Monat ist so einfach, das kannst du selbst machen.

[Daniel Albert]

Hallo snb,

also wenn der neue Monat erstellt ist brauche ich diesen wenn komplett fertig unbedingt als geschütztes Arbeitsplatz. An dieser Tabelle arbeite ich nicht sondern Kindererzieher. Es wurden schon mehrmals aus unwissenheit Formeln entfernt. Daher möchte ich zum schluss diese schützen. In der Aufbauphase wird dieser ja entfernt daher verstehe ich nicht die Meldung bei deinem Code da erst danach der Schutz wieder aktiviert wird.

Habe jetzt in deinem Code,

ActiveSheet.Cells(576, 2).Resize(UBound(sp), UBound(sp, 2)) = sp eingesetzt :)

Es funktioniert - DANKE euch allen das ging wirklich sehr sehr schnell

[snb]

Ich setze die Code immer im Codemodule des Arbeitsblattes.
Verzichte auf 'Activesheet', die Codename des Arbeitsblattes ist besser, denn invariant.

[Daniel Albert]

Verstehe ich nicht. Wie meinst du das. Ich habe deinen Code als Modul hinterlegt und nicht in dem Arbeitsblatt -Vorlage

Den Monat kann ich ja nicht nehmen da dieser erst erzeugt wird. Was ist der Nachteil andem wie ich deinen Code verwende?