AW: For ohne Next Fehlermeldung
09.01.2019 13:13:17
Rasenack
Hallo nochmal an alle fleißigen Helfer. Danke für die verschiedenen Anregungen. Ich muss allerdings den Code auch noch verstehen, wenn ich ihn länger nicht angesehen habe ;-) Deshalb sieht mein Code wahrscheinlich etwas verbesserungswürdig aus, aber im Prinzip macht er jetzt das was er soll. Vorher funktionierte mein Makro so, dass er einfach die Werte zugeordnet hat und die Zellen gefärbt hat. Drückte ich nun aus versehen nochmals den Button, begann er mir wieder irgendwelche Werte zu überschreiben, da ja zufälligerweise wieder ein 3 (aber in Euro) drin stehen konnte und er sie erkannt hat. Also war mein Gedanke das gesamte Makro gar nicht erst zu starten, wenn schon Farben in der Tabelle enthalten sind Punkt 1 und außerdem das Makro nicht starten soll, wenn die eingegeben Wörter falsch geschrieben sind. Die 1, 2, 3 habe ich nur beispielhaft angeführt, in Wahrheit sind es aber 10 Gerichte und diese Sind auch teilweise Wörter. Deshalb vorher die Schleife zur Überprüfung, um die Rechtschreibkorrektur durchführen zu können. Wenn sich nämlich so ein dummer Fehler eingeschlichen hat, konnte er das nicht als Case definieren und Übersprang einfach die Zelle. Folglich war die Gesamtsumme falsch. Wollte man jetzt diese Zelle ändern, kam wieder Punkt 1 ins Spiel.
Nichts desto Trotz habe ich auch ein Makro geschrieben mit dem es mir möglich ist im Nachhinein Essen zu korrigieren, weil es ja andauernd zu Abbestellungen bzw. Hinzubestellungen seitens der Kollegen gibt.(Im Übrigen auch mit Rechtschreibkorrektur ;-)). Hier mal der Code zur Verdeutlichung:
Sub Wertzuweisung()
Dim i As Integer
Dim k As Integer
Dim l As Integer
Dim z As Integer
Dim tagespreis(0 To 4) As Variant
Dim s As Integer
Dim wochenpreis As Double
With ThisWorkbook.Worksheets("Essenbestellung").Activate
End With
If Range("B7:F32").Interior.ColorIndex = 2 Then
'Spalte H in W?hrungsformat ?berf?hren
Range("H7:H32").NumberFormat = "0.00 ?"
'?berpr?ft vorab, ob die eingegebenen W?rter stimmen, um Berechnungsfehler zu vermeiden
For l = 7 To 32
For z = 2 To 6
If Cells(l, z).Value = 1 Or Cells(l, z).Value = 2 Or Cells(l, z).Value = 3 Or Cells(l, _
z).Value = "Pasta" Or Cells(l, z).Value = "Blau" Or Cells(l, z).Value = "Silber"
Or Cells(l, z).Value = "A" Or Cells(l, z).Value = "B" Or Cells(l, z).Value = "C"
Or Cells(l, z).Value = "E" Or Cells(l, z).Value = "" Then
Else: MsgBox ("Bei der Eingabe der Men?s ist ein Fehler aufgetreten!" & vbNewLine & " _
Bitte korrigiere die Eingabe.")
Cells(l, z).Activate
Exit Sub
End If
Next z
Next l
'Weist jedem Eingabewert den jeweiligen Preis zu und bildet anschlie?end die Summe
For k = 7 To 32
For i = 2 To 6
Select Case Cells(k, i).Value
Case 1
Cells(k, i).Interior.ColorIndex = Cells(1, 2).Interior.ColorIndex
tagespreis(i - 2) = Cells(2, 2).Value
Case 2
Cells(k, i).Interior.ColorIndex = Cells(1, 3).Interior.ColorIndex
tagespreis(i - 2) = Cells(2, 3).Value
Case 3
Cells(k, i).Interior.ColorIndex = Cells(1, 4).Interior.ColorIndex
tagespreis(i - 2) = Cells(2, 4).Value
Case "Pasta"
Cells(k, i).Interior.ColorIndex = Cells(1, 5).Interior.ColorIndex
tagespreis(i - 2) = Cells(2, 5).Value
Case "Silber"
Cells(k, i).Interior.ColorIndex = Cells(1, 6).Interior.ColorIndex
tagespreis(i - 2) = Cells(2, 6).Value
Case "Blau"
Cells(k, i).Interior.ColorIndex = Cells(1, 7).Interior.ColorIndex
tagespreis(i - 2) = Cells(2, 7).Value
Case "A"
Cells(k, i).Interior.ColorIndex = Cells(1, 8).Interior.ColorIndex
tagespreis(i - 2) = Cells(2, 8).Value
Case "B"
Cells(k, i).Interior.ColorIndex = Cells(1, 9).Interior.ColorIndex
tagespreis(i - 2) = Cells(2, 9).Value
Case "C"
Cells(k, i).Interior.ColorIndex = Cells(1, 10).Interior.ColorIndex
tagespreis(i - 2) = Cells(2, 10).Value
Case "E"
Cells(k, i).Interior.ColorIndex = Cells(1, 11).Interior.ColorIndex
tagespreis(i - 2) = Cells(2, 11).Value
Case ""
tagespreis(i - 2) = 0
End Select
Next i
'Einzelwerte des Arrays zeilenweise aufsummieren und in Spalte Hk eintragen
wochenpreis = 0
For s = 0 To 4
wochenpreis = wochenpreis + tagespreis(s)
Next s
If wochenpreis > 0 Then
Cells(k, 8).Value = wochenpreis
End If
Next k
Else
Select Case MsgBox("Die Tabelle muss erst vollst?ndig gel?scht sein, bevor du die _
Gesamtsumme erneut berechnen m?chtest!" & vbNewLine & "Soll die Tabelle jetzt gel?scht werden?", vbYesNo)
Case vbYes
Call TabelleLeeren
Case vbNo
End Select
End If
Call Tabelle_Laola
End Sub