Fehler in VBA Code

21/01/2011 - 18:57 von Frank | Report spam
Guten Abend zusammen,

da mir die Kenntnisse in der VBA Programmierung fehlen, wende ich mich
an Euch.

Folgender Sachverhalt:

Ich habe 10 ComboBoxen, über die ich verschieden Funktionen auswàhle.

Private Sub Runde1_Change()
Call Berechne(Runde1.Value, "F8:F161", "F3", "J3")
End Sub

Private Sub Runde2_Change()
Call Berechne(Runde2.Value, "M8:M161", "M3", "Q3")
End Sub

Private Sub Runde3_Change()
Call Berechne(Runde3.Value, "T8:T161", "T3", "X3")
End Sub

Private Sub Runde4_Change()
Call Berechne(Runde4.Value, "AA8:AA161", "AA3", "AE3")
End Sub

Private Sub Runde5_Change()
Call Berechne(Runde5.Value, "AH8:AH161", "AH3", "AL3")
End Sub

Private Sub Runde6_Change()
Call Berechne(Runde6.Value, "AO8:AO161", "AO3", "AS3")
End Sub

Private Sub Runde7_Change()
Call Berechne(Runde7.Value, "AV8:AV161", "AV3", "AZ3")
End Sub

Private Sub Runde8_Change()
Call Berechne(Runde.Value, "BC8:BC161", "BC3", "BG3")
End Sub

Private Sub Runde9_Change()
Call Berechne(Runde9.Value, "BJ8:BJ161", "BJ3", "BN3")
End Sub

Private Sub Runde10_Change()
Call Berechne(Runde10.Value, "BQ8:BQ161", "BQ3", "BU3")
End Sub

In Zelle F3 kommt die Zahl für die Quersumme, in Zelle J3 der Teiler für
die Division. Entsprechendes gilt für die anderen Zellen(M3,T3 usw.)

Nun habe ich einen entsprechenden Code,der leider ein wenig zu haken
scheint. Ich bekomme immer die Fehlermeldung "Laufzeitfehler 13 Typen
unvertràglich"

Nachfolgend mal der Code, in der Hoffnung jemand kann was damit anfangen.

ub Berechne(Was As String, Wo As String, QS As String, Durch As String)
Dim strZ As String
With Worksheets("Tabbi").Range(Wo).Offset(0, 1)
strZ = Range(Wo).Cells("A1").Address(0, 0)
Application.ScreenUpdating = False
Select Case Was
Case "Quersumme"
.FormulaLocal = "=WENN(UND(" & strZ & "<>"""";Quersumme(" &
strZ & ";" & .Parent.Range(QS) & "));100;"""")"
Case "Durch"
.FormulaLocal = "=WENN(UND(" & strZ & "<>"""";Durch(" & strZ &
";" & .Parent.Range(QS) & "));100;"""")"
Case "Primzahl"
.FormulaLocal = "=WENN(UND(" & strZ & "<>"""";Primzahl(" &
strZ & "));100;"""")"
Case "Nix machen"
.ClearContents
Case Else
'nix
End Select
.Value = .Value
Application.ScreenUpdating = True
End With
End Sub


Function Quersumme(Zelle As Range, QS As Integer) As Boolean
Dim intI As Integer, Summe As Integer
For intI = 1 To Len(Zelle.Value)
Summe = Summe + CInt(Mid(Zelle.Value, intI, 1))
Next
Quersumme = IIf(Summe = QS, True, False)
End Function

Function Durch(Zelle As Range, Teiler As Integer) As Boolean
Durch = IIf(Zelle.Value Mod Teiler = 0, True, False)
End Function

Function Primzahl(Zelle As Range) As Boolean
Dim N As Integer
For N = Zelle.Value - 1 To 2 Step -1
If Zelle.Value Mod N = 0 Then
Primzahl = True
Exit For
End If
Next N
Primzahl = Not Primzahl
End Function


LG Frank
 

Lesen sie die antworten

#1 Wolfgang Habernoll
22/01/2011 - 01:06 | Warnen spam
Frank schrieb:
Guten Abend zusammen,

da mir die Kenntnisse in der VBA Programmierung fehlen, wende ich mich
an Euch.

Folgender Sachverhalt:

Ich habe 10 ComboBoxen, über die ich verschieden Funktionen auswàhle.

Private Sub Runde1_Change()
Call Berechne(Runde1.Value, "F8:F161", "F3", "J3")
End Sub

Private Sub Runde2_Change()
Call Berechne(Runde2.Value, "M8:M161", "M3", "Q3")
End Sub

Private Sub Runde3_Change()
Call Berechne(Runde3.Value, "T8:T161", "T3", "X3")
End Sub

Private Sub Runde4_Change()
Call Berechne(Runde4.Value, "AA8:AA161", "AA3", "AE3")
End Sub

Private Sub Runde5_Change()
Call Berechne(Runde5.Value, "AH8:AH161", "AH3", "AL3")
End Sub

Private Sub Runde6_Change()
Call Berechne(Runde6.Value, "AO8:AO161", "AO3", "AS3")
End Sub

Private Sub Runde7_Change()
Call Berechne(Runde7.Value, "AV8:AV161", "AV3", "AZ3")
End Sub

Private Sub Runde8_Change()
Call Berechne(Runde.Value, "BC8:BC161", "BC3", "BG3")
End Sub

Private Sub Runde9_Change()
Call Berechne(Runde9.Value, "BJ8:BJ161", "BJ3", "BN3")
End Sub

Private Sub Runde10_Change()
Call Berechne(Runde10.Value, "BQ8:BQ161", "BQ3", "BU3")
End Sub

In Zelle F3 kommt die Zahl für die Quersumme, in Zelle J3 der Teiler für
die Division. Entsprechendes gilt für die anderen Zellen(M3,T3 usw.)

Nun habe ich einen entsprechenden Code,der leider ein wenig zu haken
scheint. Ich bekomme immer die Fehlermeldung "Laufzeitfehler 13 Typen
unvertràglich"

Nachfolgend mal der Code, in der Hoffnung jemand kann was damit anfangen.

ub Berechne(Was As String, Wo As String, QS As String, Durch As String)
Dim strZ As String
With Worksheets("Tabbi").Range(Wo).Offset(0, 1)
strZ = Range(Wo).Cells("A1").Address(0, 0)
Application.ScreenUpdating = False
Select Case Was
Case "Quersumme"
.FormulaLocal = "=WENN(UND(" & strZ & "<>"""";Quersumme(" & strZ & ";" &
.Parent.Range(QS) & "));100;"""")"
Case "Durch"
.FormulaLocal = "=WENN(UND(" & strZ & "<>"""";Durch(" & strZ & ";" &
.Parent.Range(QS) & "));100;"""")"
Case "Primzahl"
.FormulaLocal = "=WENN(UND(" & strZ & "<>"""";Primzahl(" & strZ &
"));100;"""")"
Case "Nix machen"
.ClearContents
Case Else
'nix
End Select
.Value = .Value
Application.ScreenUpdating = True
End With
End Sub


Function Quersumme(Zelle As Range, QS As Integer) As Boolean
Dim intI As Integer, Summe As Integer
For intI = 1 To Len(Zelle.Value)
Summe = Summe + CInt(Mid(Zelle.Value, intI, 1))
Next
Quersumme = IIf(Summe = QS, True, False)
End Function

Function Durch(Zelle As Range, Teiler As Integer) As Boolean
Durch = IIf(Zelle.Value Mod Teiler = 0, True, False)
End Function

Function Primzahl(Zelle As Range) As Boolean
Dim N As Integer
For N = Zelle.Value - 1 To 2 Step -1
If Zelle.Value Mod N = 0 Then
Primzahl = True
Exit For
End If
Next N
Primzahl = Not Primzahl
End Function


LG Frank



Hallo Frank

versuche es mal zuerst folgende Zeile zu àndern
'strZ = Range(Wo).Cells("A1").Address(0, 0)

in
strZ = Range(Wo).Cells(1, 1).Address(0, 0)

oder wenn es A1 sein soll dann nimm Range
strZ = Range(Wo).Range("A1").Address(0, 0)

das sollte der "Laufzeitfehler 13" sein, zum Rest sag ich nix, ist schon
spàt ;-)

mfG
Wolfgang Habernoll

Ähnliche fragen