AW: Danke an Rudi und Luc ;-) owT
09.07.2015 12:02:24
Daniel
Ich habe es mit dem Code probiert, leider funktioniert es nicht :(
Hier nochmals mein Code, dieses mal der komplette:
Private Sub CommandButton3_Click()
Dim Ergebnis As Double
Dim TendenzAC As Double
Dim xZeile As Long
If TextBox1 = "" Then Exit Sub 'keine Eingabe -> Sub wird beendet
If TextBox2 = "" Then Exit Sub 'keine Eingabe -> Sub wird beendet _
If TextBox3 = "" Then Exit Sub 'keine Eingabe -> Sub wird beendet
Cells(ComboBox1.ListIndex + 3, 2) = TextBox1 'Name
Cells(ComboBox1.ListIndex + 3, 3) = TextBox2 'Vorname
Cells(ComboBox1.ListIndex + 3, 4) = TextBox3 'Studiengang
Cells(ComboBox1.ListIndex + 3, 17) = TextBox4 'Teil 1
Cells(ComboBox1.ListIndex + 3, 18) = TextBox5 'Teil 2
Cells(ComboBox1.ListIndex + 3, 19) = TextBox6 'Teil 3
Cells(ComboBox1.ListIndex + 3, 20) = TextBox7 'Teil 4
Cells(ComboBox1.ListIndex + 3, 21) = TextBox8 'Teil 5
Cells(ComboBox1.ListIndex + 3, 22) = TextBox9 'Teil 6
Cells(ComboBox1.ListIndex + 3, 23) = TextBox10 'Teil 7
Cells(ComboBox1.ListIndex + 3, 24) = TextBox11 'Teil 8
Cells(ComboBox1.ListIndex + 3, 25) = TextBox12 'Teil 9
Cells(ComboBox1.ListIndex + 3, 26) = TextBox13 'Vorstellung / Präsentation
Cells(ComboBox1.ListIndex + 3, 27) = TextBox14 'Obelisk
Cells(ComboBox1.ListIndex + 3, 28) = TextBox15 'Turmbau
Cells(ComboBox1.ListIndex + 3, 29) = TextBox16 'Diskussionsrunde
If TextBox4 = "" Then
MsgBox "Bitte Punkteanzahl eingeben in die Rubrik Teil 1!", vbInformation
Exit Sub
End If 'keine Eingabe -> Sub wird beendet"
If TextBox5 = "" Then
MsgBox "Bitte Punkteanzahl eingeben in die Rubrik Teil 2!", vbInformation
Exit Sub
End If 'keine Eingabe -> Sub wird beendet
If TextBox6 = "" Then
MsgBox "Bitte Punkteanzahl eingeben in die Rubrik Teil 3!", vbInformation
Exit Sub
End If 'keine Eingabe -> Sub wird beendet
If TextBox7 = "" Then
MsgBox "Bitte Punkteanzahl eingeben in die Rubrik Teil 4!", vbInformation
Exit Sub
End If 'keine Eingabe -> Sub wird beendet
If TextBox8 = "" Then
MsgBox "Bitte Punkteanzahl eingeben in die Rubrik Teil 5!", vbInformation
Exit Sub
End If 'keine Eingabe -> Sub wird beendet
If TextBox9 = "" Then
MsgBox "Bitte Punkteanzahl eingeben in die Rubrik Teil 6!", vbInformation
Exit Sub
End If 'keine Eingabe -> Sub wird beendet
If TextBox10 = "" Then
MsgBox "Bitte Punkteanzahl eingeben in die Rubrik Teil 7!", vbInformation
Exit Sub
End If 'keine Eingabe -> Sub wird beendet
If TextBox11 = "" Then
MsgBox "Bitte Punkteanzahl eingeben in die Rubrik Teil 8!", vbInformation
Exit Sub
End If 'keine Eingabe -> Sub wird beendet
If TextBox12 = "" Then
MsgBox "Bitte Punkteanzahl eingeben in die Rubrik Teil 9!", vbInformation
Exit Sub
End If 'keine Eingabe -> Sub wird beendet
If TextBox13 = "" Then
MsgBox "Bitte Punkteanzahl eingeben in die Rubrik Vorstellung / Präsentation!", vbInformation
Exit Sub
End If 'keine Eingabe -> Sub wird beendet
If TextBox14 = "" Then
MsgBox "Bitte Punkteanzahl eingeben in die Rubrik Obelisk!", vbInformation
Exit Sub
End If 'keine Eingabe -> Sub wird beendet
If TextBox15 = "" Then
MsgBox "Bitte Punkteanzahl eingeben in die Rubrik Turmbau!", vbInformation
Exit Sub
End If 'keine Eingabe -> Sub wird beendet
If TextBox16 = "" Then
MsgBox "Bitte Punkteanzahl eingeben in die Rubrik Diskussionsrunde!", vbInformation
Exit Sub
End If 'keine Eingabe -> Sub wird beendet
'Hochkomma entfernen
For xZeile = 1 To Range("E65536").End(xlUp).Row
If IsNumeric(Range("P" & xZeile).Value) Then
Range("P" & xZeile).Value = Range("P" & xZeile).Value * 1
End If
If IsNumeric(Range("Q" & xZeile).Value) Then
Range("Q" & xZeile).Value = Range("Q" & xZeile).Value * 1
End If
If IsNumeric(Range("R" & xZeile).Value) Then
Range("R" & xZeile).Value = Range("R" & xZeile).Value * 1
End If
If IsNumeric(Range("S" & xZeile).Value) Then
Range("S" & xZeile).Value = Range("S" & xZeile).Value * 1
End If
If IsNumeric(Range("T" & xZeile).Value) Then
Range("T" & xZeile).Value = Range("T" & xZeile).Value * 1
End If
If IsNumeric(Range("U" & xZeile).Value) Then
Range("U" & xZeile).Value = Range("U" & xZeile).Value * 1
End If
If IsNumeric(Range("V" & xZeile).Value) Then
Range("V" & xZeile).Value = Range("V" & xZeile).Value * 1
End If
If IsNumeric(Range("W" & xZeile).Value) Then
Range("W" & xZeile).Value = Range("W" & xZeile).Value * 1
End If
If IsNumeric(Range("X" & xZeile).Value) Then
Range("X" & xZeile).Value = Range("X" & xZeile).Value * 1
End If
If IsNumeric(Range("Y" & xZeile).Value) Then
Range("Y" & xZeile).Value = Range("Y" & xZeile).Value * 1
End If
If IsNumeric(Range("Z" & xZeile).Value) Then
Range("Z" & xZeile).Value = Range("Z" & xZeile).Value * 1
End If
If IsNumeric(Range("AA" & xZeile).Value) Then
Range("AA" & xZeile).Value = Range("AA" & xZeile).Value * 1
End If
If IsNumeric(Range("AB" & xZeile).Value) Then
Range("AB" & xZeile).Value = Range("AB" & xZeile).Value * 1
End If
If IsNumeric(Range("AC" & xZeile).Value) Then
Range("AC" & xZeile).Value = Range("AC" & xZeile).Value * 1
End If
Next xZeile
'Ergebnis für Tendenz (AC) berechnen
Ergebnis = (CDbl(TextBox4) + CDbl(TextBox5) + CDbl(TextBox6) + CDbl(TextBox7) + CDbl(TextBox8) + _
CDbl(TextBox9) + CDbl(TextBox10) + CDbl(TextBox11) _
+ CDbl(TextBox12) + CDbl(TextBox13) + CDbl(TextBox14) + CDbl(TextBox15) + CDbl(TextBox16)) / 13
'Ergebnis in Splate 29 ausgeben
Cells(ComboBox1.ListIndex + 3, 30) = Ergebnis
'TendenzAC auf drei Stellen runden
TendenzAC = Application.WorksheetFunction.Round(Ergebnis, 3)
Cells(ComboBox1.ListIndex + 3, 8) = TendenzAC
'Tendenz farbig darstellen in Abhängigkeit des Wertes (Ergebnis)
If Cells(ComboBox1.ListIndex + 3, 8) > 8 Then
Cells(ComboBox1.ListIndex + 3, 8).Interior.ColorIndex = 50 'grün
End If
If Cells(ComboBox1.ListIndex + 3, 8) > 9 Then
Cells(ComboBox1.ListIndex + 3, 8).Interior.ColorIndex = 4 'hellgrün
End If
If Cells(ComboBox1.ListIndex + 3, 8) Datum an dem Eintrag erfolgte
Cells(ComboBox1.ListIndex + 3, 31) = Date
UserForm_Initialize
End Sub
LG
Daniel