Hallo Leute,
ich bin ja bemüht,zu lernen und zu verstehen.Wenn aber Magie mit im Spiel ist,kapituliere ich.
Ich liste jetzt mal meine einzelnen Codes auf und am Ende erklär ich mal mein Problem.
Modul 1:
Function Alle(Was As String, ByRef Zelle As Range) As Boolean
Dim intI As Integer, Wert As Integer, intVergleich As Integer
Select Case Was
Case "QS-Solo"
intVergleich = Tabelle1.Cells(8, Zelle.Column + 1).Value
For intI = 1 To Len(Zelle.Value)
Wert = Wert + CInt(Mid(Zelle.Value, intI, 1))
Next
Alle = IIf(Wert = intVergleich, True, False)
Case "Durch-Solo"
intVergleich = Tabelle1.Cells(8, Zelle.Column + 5).Value
On Error Resume Next
Alle = IIf(Zelle.Value Mod intVergleich = 0, True, False)
On Error GoTo 0
Case "Prim-Solo"
For intI = 2 To Int(Sqr(Zelle.Value))
If Zelle.Value Mod intI = 0 Then Exit For
Next intI
Alle = intI \> Int(Sqr(Zelle.Value))
Case Else
'nix
End Select
End Function
Anmerkung: Alle 3 „Case-Anweisungen“ klappen einwandfrei
Sub Berechne(strWas As String, strWo As String)
Dim strZ As String, ZeiS As Long, ZeiP As Long, Zei As Long
Dim rngWo As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("Tabbi")
Set rngWo = .Range(strWo)
rngWo.Offset(0, 1).Resize(154, 3).ClearContents
If strWas = "Nix machen" Then GoTo Ende
For Zei = 0 To 150 Step 5
If Application.Sum(rngWo.Offset(Zei, 0).Resize(4, 1)) 0 Then
For ZeiS = 0 To 3 Step 1
If rngWo.Offset(Zei + ZeiS, 0) "" Then
If Alle(strWas, rngWo.Offset(Zei + ZeiS, 0)) = True Then
rngWo.Offset(Zei + ZeiS, 1).Value = .Cells(2, rngWo.Column + 5) 'rngWo.Offset(Zei + ZeiS, 1).Value = .Cells(2, rngWo.Column + 3)
End If
End If
Next ZeiS
End If
Next Zei
End With
Ende:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Tabelle 1:
Private Sub Worksheet\_Change(ByVal Target As Range)
Dim OK As Boolean, N As Integer, Wert, Auswahl As String
On Error GoTo hell
If Target.Count \> 1 Then Exit Sub
If Target.Row \> 166 Or Target.Row 5 Then
For N = 6 To 104 Step 7
If Target.Column = N Then
OK = True
Exit For
End If
Next N
Else
OK = True
End If
If OK = False Then Exit Sub
If Target.Value = "" And Target.Column = 5 Then Exit Sub 'Von nier
If Target.Column = 5 Then
If Target.Value = "" Then Exit Sub
If Application.CountIf(Range("E13:E166"), Target.Value) \> 1 Then
Application.EnableEvents = False
MsgBox Target.Value & " ist doppelt vorhanden"
Target.ClearContents
Target.Select
Application.EnableEvents = True
End If 'bis hier ist der Teil beinahe identisch mit dem auskommentierten weiter unten
Else
Application.EnableEvents = False
Auswahl = Tabelle1.OLEObjects("Runde" & CInt((Target.Column + 1) / 7)).Object.Value
If Auswahl "Nix machen" Then
Call Berechne(Auswahl, Cells(13, Target.Column).Address(0, 0))
End If
End If
hell:
If Err.Number 0 Then MsgBox Err.Number & vbCr & Err.Description
Application.EnableEvents = True
End Sub
Private Sub Worksheet\_SelectionChange(ByVal Target As Range)
Dim Ber As Range, Index As Integer, i, Wert, N As Integer
If Target.Count 1 Then Exit Sub
If Target.Row 166 Then Exit Sub
For N = 1 To 15 'Anzahl der Runden
If Not Ber Is Nothing Then
Set Ber = Application.Union(Ber, Columns(6 + (N - 1) \* 7))
Else
Set Ber = Columns(6 + (N - 1) \* 7)
End If
Next N
If Intersect(Target, Ber) Is Nothing Then Exit Sub
Wert = Application.Sum(Target.Offset(-(Target.Row + 2) Mod 5, 0).Resize(4, 1))
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Cells(2, Target.Column + 1).Value = Wert 'Range(Ber(Index) & "2").Value = Wert Diese Zeile muss m.E. abgeändert werden
Cells(3, Target.Column + 1).Value = "Tisch " & Cells(Target.Offset(-(Target.Row + 2) Mod 5).Row, 4).Value 'Range(Ber(Index) & "3").Value = "Tisch " & Cells(Target.Offset(-(Target.Row + 2) Mod 5).Row, 4).Value Diese Zeile muss m.E. abgeändert werden
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
So,ich habe mittlerweile gelernt,dass es die Funktion „Primzahl“ als vordefinierte Funktion gibt,Quersumme und Division nicht,sondern nur als benutzerdefinierte.
Wenn ich nun aber die benutzerdefinierte Funktion von Quersumme auskommentiere,die sogar nachträglich erst hinzugekommen ist,und die Case-Anweisung QS-Solo trotzdem funktioniert,fange ich an zu verzweifeln.
Da Reinhard die gute Seele erst aus dem KH entlassen worden ist,möchte ich ihn nicht direkt damit überfallen.
Deshalb meine Frage an Euch. Wo in dem gottverdammten Code stecken die 3 Berechnungen der Case-Anweisungen „QS-Solo“,„Durch-Solo“ und „Prim-Solo“? Irgendwo müssen die doch mit qsum,prim oder dem / Strich angesprochen werden,oder mit was auch immer.
Wenn ich das gefunden habe,kann ich auch weiter nachlesen.Achso,ist es normal, dass ich diese Codezeilen nicht mit der F8-Taste Zeile für Zeile abarbeiten kann.Es kommt immer nur ein Ping.Bei anderen Teilen klappt das wunderbar.
Hier könnt ihr Euch die Tabbi mal ansehen,wer mag
http://www.file-upload.net/download-7285085/Meine-Te…
LG Frank
