Keine Ahnung von VBA

Computer: Software & Programmierung Office Software
1

Hallo und einen schönen guten MOrgen zusammen,

folgender Code ist dank der Hilfe von Reinhard vorhanden:

Sub Berechne(Was As String)
With Worksheets(„Tabbi“).Range(„G8:G161“)
Application.ScreenUpdating = False
Select Case Was
Case „Quersumme“
.FormulaLocal = „=WENN(UND(F8"“"";Quersumme(F8;" & .Parent.Range(„J3“) & „));100;“""")"
Case „Durchdrei“
.FormulaLocal = „=WENN(UND(F8"“"";DurchDrei(F8));100;"""")"
Case „Primzahl“
.FormulaLocal = „=WENN(UND(F8"“"":stuck_out_tongue_winking_eye:rimzahl(F8));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 DurchDrei(Zelle As Range) As Boolean
DurchDrei = IIf(Zelle.Value Mod 3 = 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

Diesen Code brauche ich für 10 Bereiche, die ich entsprechend anpasse. M8:161, T8:T161 usw.

Gehe ich nun recht in der Annahme, dass ich diesen Code 9 mal duplizieren muss?

Meine zweite Frage betrifft die Funktion durch drei.

Hier möchte ich nun den Teiler genauso aus einer ComboBox auswählen wie bei der Quersumme - hier Zelle J3.

Wie gesagt,mir fehlen jeglich Kenntnisse in VBA und in den vielen Foren finde ich auch nichts passendes,was ich grob übernehmen könnte.

LG Frank

2

Hallo Frank,

Diesen Code brauche ich für 10 Bereiche, die ich entsprechend
anpasse. M8:161, T8:T161 usw.

Gehe ich nun recht in der Annahme, dass ich diesen Code 9 mal
duplizieren muss?

Könntest du, nimm den nachstehenden neuen (ungetesteten) Code.
Da brauchst du nur in der Klammer
arrBer = Array(„G“, „M“, „T“)
die 10 Spalten angeben.

Meine zweite Frage betrifft die Funktion durch drei.
Hier möchte ich nun den Teiler genauso aus einer ComboBox
auswählen wie bei der Quersumme - hier Zelle J3.

Ist eingebaut, im Code die J4.

Gruß
Reinhard

Sub Berechne(Was As String)
Dim strZ As String, arrBer, B As Integer
arrBer = Array("G", "M", "T")
Application.ScreenUpdating = False
For B = LBound(arrBer) To UBound(arrBer)
 With Worksheets("Tabbi").Range(arrBer(B) & "8:" & arrBer(B) & "161")
 strZ = Range(arrBer(B) & "8").Offset(0, -1).Address(0, 0)
 Select Case Was
 Case "Quersumme"
 .FormulaLocal = "=WENN(UND(" & strZ & """"";Quersumme(" & strZ & ";" & .Parent.Range("J3") & "));100;"""")"
 Case "Durchdrei"
 .FormulaLocal = "=WENN(UND(" & strZ & """"";DurchDrei(" & strZ & ";" & .Parent.Range("J4") & "));100;"""")"
 Case "Primzahl"
 .FormulaLocal = "=WENN(UND(" & strZ & """"":stuck\_out\_tongue\_winking\_eye:rimzahl(" & strZ & "));100;"""")"
 Case "Nix machen"
 .ClearContents
 Case Else
 'nix
 End Select
 .Value = .Value
 End With
Next B
Application.ScreenUpdating = True
End Sub

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

Hallo Reinhard,

zunächst einmal Danke für die schnelle Antwort. Funktion „Durch“ klappt einwandfrei.

Den Code für die Berechnung nützt mir so nichts. Ich brauch die ComboBox für jeden Bereich separat, d.h. 9 ComboBoxen und 9x den Code.

Ich möchte jeden Bereich einzeln, nach Bedarf abfragen, wie bei dem von dir erstellten Code im Bereich F8.

Ich hoffe, ich konnte mich verständlich ausdrücken.

LG Frank

4

Den Code für die Berechnung nützt mir so nichts. Ich brauch
die ComboBox für jeden Bereich separat, d.h. 9 ComboBoxen und
9x den Code.

Ich möchte jeden Bereich einzeln, nach Bedarf abfragen, wie
bei dem von dir erstellten Code im Bereich F8.

Hallo Frank,

mit normalem Vba brauchste dann was 10mal, aber nur den Aufruf, also das was in dem Modul „Tabelle2(Tabbi)“ steht, so etwa:

Private Sub ComboBox2_Change()
Call Berechne(ComboBox1.Value)
End Sub

Private Sub ComboBox2_Change()
Call Berechne(ComboBox2.Value)
End Sub

usw. bis

Private Sub ComboBox10_Change()
Call Berechne(ComboBox10.Value)
End Sub

Das geht ja fix manuell durch kopieren. Aber lass das jetzt noch, der Call-Befehl wird verändert.

Pro Combobox muß ich wissen,

den Bereich z.B. G8:G161
die Zelle mit der QS-Vorgabe z.B. J3
die Zelle mit dem Teiler für „Durch“, z.B. J4

Gruß
Reinhard

5

Hallo Reinhard,

Hier mal die Bereiche, die geprüft werden sollen:

F8-F161 - QS F3, Durch J3
M8-M161 - QS M3, Durch Q3
T8-T161 - QS T3, Durch X3
AA8- - QS AA3, Durch AE3
AH8- - QS AH3, Durch AL3
AO8- - QS AO3, Durch AS3
AV8- - QS AV3, Durch AZ3
BC8- - QS BC3, Durch BG3
BJ8- - QS BJ3, Durch BN3
BQ8- - QS BQ3, Durch BU3

LG Frank

6

Hallo Frank,

ungetestet, wenn was nicht klappt, dann lade bitte eine Beispielmappe hoch mit file-upload.

Für Modul Tabelle2 habe ich nur die ersten beiden Codes entwickelt, die anderen acht mußte selbst basteln, aber ist in Minuten gesche#hen.

Gruß
Reinhard

in Modul3

Sub 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 "Durchdrei"
 .FormulaLocal = "=WENN(UND(" & strZ & """"";DurchDrei(" & strZ & ";" & .Parent.Range(QS) & "));100;"""")"
 Case "Primzahl"
 .FormulaLocal = "=WENN(UND(" & strZ & """"":stuck\_out\_tongue\_winking\_eye:rimzahl(" & strZ & "));100;"""")"
 Case "Nix machen"
 .ClearContents
 Case Else
 'nix
 End Select
 .Value = .Value
 Application.ScreenUpdating = True
End With
End Sub

in Modul Tabelle2:

Private Sub ComboBox1\_Change()
Call Berechne(ComboBox1.Value, "F8:F161", "F3", "J3")
End Sub

Private Sub ComboBox2\_Change()
Call Berechne(ComboBox2.Value, "M8:M161", "M3", "Q3")
End Sub

'...
7

Hallo Reinhard,

habe deinen Code so in die Tabbi eingebaut und entsprechend angepasst. Leider gibt Excel mir einen Laufzeitfehler.

Hier der Link für die Tabbi :

http://www.file-upload.net/download-3137265/kwTabbi-…

LG Frank

8

Hallo Frank,

habe deinen Code so in die Tabbi eingebaut und entsprechend
angepasst. Leider gibt Excel mir einen Laufzeitfehler.

bitte bei sowas immer die Codezeile angeben.

Hier der Link für die Tabbi :

http://www.file-upload.net/download-3137265/kwTabbi-…

Den Laufzeitfehler habe ich beseitigt, aber der Code hakt noch. Unterstütz mich mal und lade eine neue Mappe hoch, wo du die Spalten M,T usw mit Beispielzahlen ausfüllst, auch die jeweiligen QS und Durch Werte obendrüber.
Zahlen so wählen daß je nach Auswahl mal 100 oder nix angezeigt werden soll.

Gruß
Reinhard