Getränkeliste erweitern

[Pivo]

Hallo,
ich habe vor längerer Zeit eine Getränkeliste bekommen um sie für unsere Zwecke, einem kleinen Verein mit 30 Mitgliedern, zu ändern.
Bevor ich mich jetzt daran versuche diese "Hübsch" zu machen habe ich eine Frage:
So wie die Tabelle jetzt ist kann immer nur eine Getränkeart ausgewählt werden und muß dann gebucht werden bevor die selbe Person noch ein anderes Getränk mitnehmen kann. Kann man das ändern das 2 oder 3 verschiedene getränke ausgewält werden können vor dem buchen??  

Ich hoffe das mir einer Helfen kann.

[Käpt'n Blaubär]

Hallo,

Bevor ich mich jetzt daran versuche diese "Hübsch" zu machen habe ich eine Frage:

da man meiner bescheidenen Meinung nach bei Deinem Vorhaben die Makros eh großflächig ändern muß
mein Vorschlag, mach sie "Hübsch" bzw. baue Dir eine eigene Datei auf, so wie Du Dir das vorstellst.

Danach können wir uns über die Makrosteuerung Gedanken machen und ... ja klar ist Deine Vorstellung
erfüllbar. Aber eben mit anderen Makros und wenn Du die Datei sowieso Hübschen willst, dann sollte das
vorher passieren. Sonst wäre das letztendlich ja doppelte Arbeit.

[Pivo]

Hallo Käpt`n Blaubär,
die hochgeladene Datei ist die Ursprungsdatei die ich in vielen Funktionen schon abgeändert habe. Nur noch nicht "Hübsch" :19: .
Das Ganze funktioniert jetzt mit Transpondern für die einzelnen Mitglieder zum buchen Ihrer Getränke und die Arbeitsblätter sind natürlich Passwortgeschützt.
Ich kann ja mal den jetzigen Stand der Dinge hochladen wenn es helfen würde.

[Käpt'n Blaubär]

Hallo,

Ich kann ja mal den jetzigen Stand der Dinge hochladen wenn es helfen würde.

Hmmmm, ...
wünsche Dir besser nicht, daß ich darauf wirklich antworte  :05:
Was will ich mit einer Datei Stand: vorletzte Weihnachten

[Kuwer]

Hallo Pivo,

so würde ich das vielleicht machen:

Private Sub CommandButton1_Click()

Dim rng As Range, C As Range, Loletzte As Long, maxEintrag As Long

maxEintrag = 5000 'max. Zeilenanzahl für Umsatztabelle



Loletzte = Tabelle2.Cells(Rows.Count, 1).End(xlUp).Row + 1

If Loletzte > maxEintrag Then MsgBox "! Protokoll läuft über !", vbCritical: Range("Mitglied") = "": Range("Getränk") = "": Range("Anzahl") = 1: Exit Sub

If Loletzte > maxEintrag - 2 Then MsgBox "Protokoll läuft bald über", vbInformation



Application.ScreenUpdating = False

ActiveSheet.Unprotect

If Range("Mitglied") <> "" And Range("Getränk") <> "" Then

 For Each rng In Range("Liste")

   If rng.Value = Range("Mitglied").Value Then

     rng.Offset(, 2) = rng.Offset(, 2) - (Range("Preis") * Range("Anzahl"))

     For Each C In Range("D2:D61")

       If C.Value = Range("Getränk").Value Then

         C.Offset(, 2) = C.Offset(, 2) + Range("Anzahl")

         Tabelle2.Unprotect

         Tabelle2.Cells(Loletzte, 1) = Date

         Tabelle2.Cells(Loletzte, 2) = Range("Getränk")

         Tabelle2.Cells(Loletzte, 3) = Range("Preis")

         Tabelle2.Cells(Loletzte, 4) = Range("Anzahl")

         Tabelle2.Cells(Loletzte, 5) = Range("Umsatz")

         Tabelle2.Cells(Loletzte, 6) = Range("Mitglied")

         Tabelle2.Protect

         Exit For

       End If

     Next

     If MsgBox("Bei: " & Range("Mitglied").Value & " wurden " & vbLf & Format(Range("Preis") * Range("Anzahl"), "0.00 €") & " abgebucht." & _

               String(2, vbNewLine) & "Noch mehr Getränke kaufen?", vbYesNo + vbQuestion) = vbNo Then

       Range("Mitglied") = ""

     Else

       Range("Getränk").Select

     End If

     Range("Anzahl") = 1

     Range("Getränk") = ""

     Exit For

   End If

 Next

 If maxEintrag - Loletzte < 5 And maxEintrag - Loletzte > 1 Then MsgBox "noch " & maxEintrag - Loletzte & " Einträge frei", vbInformation

 If maxEintrag - Loletzte = 1 Then MsgBox "nur noch " & maxEintrag - Loletzte & " Eintrag frei", vbInformation

 If maxEintrag = Loletzte Then MsgBox "Es ist kein neuer Eintrag mehr frei", vbCritical, "Protokollüberlauf"

End If



ActiveSheet.Protect

Application.ScreenUpdating = True

End Sub

Gruß Uwe