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