VBA Code für ganzzahlige Teiler, Hilfe benötigt

[F r a n k]

Hallo Forum,

ich bin ganz frisch hier angemeldet weil ich leider alleine nicht mehr weiter komme. Ich habe schon viele Stunden mit dem www verbracht bin aber noch nicht am Ziel. Deshalb möchte ich um Mithilfe bitten.

Meine Problemstellung.
In Zelle A1 treffe ich über ein Dropdown die Auswahl zwischen den Zahlen 1-240 (Monate).
In Zelle A2 (oder andere, erstmal unbedeutend) habe ich einen Dropdown der ganzzahlige Teiler von A1, je nach Zahl mehr oder weniger viele, aufsteigend sortiert anbietet.
In Zelle A3 (oder andere, erstmal unbedeutend) habe ich einen Dropdown der ganzzahlige Teiler von A2, je nach Zahl mehr oder weniger viele, eher wenige, und aufsteigend sortiert.

Beispiel:
Ich wähle in A1 240 aus, dann zeigt mir der Dropdown von A2 1,2,3,4,5,6,8,10,12,15,16,24,30,40,48,60,80,120 und 240 selbst natürlich auch.
In A2 entscheide ich mich jetzt für 30, und kann im Dropdown von A3 nur noch zwischen 1,2,3,5,6,10,15 und 30 wählen. Bei ungeraden Zahlen oder kleineren Zahlen ist natürlich deutlich weniger Auswahl.

gesuchte Lösung:
Mir reicht der Schritt wie ich von der Zahl aus A1 in eine aufsteigend sortierte Hilfsspalte komme, in der dann meinetwegen von B1 - Bn die ganzzahligen Teiler von A1 einzeln enthalten sind.

was ich habe:
die ganzzahligen Teiler von A1 getrennt durch beliebiges Zeichen alle als array in einer Zelle!

Code:

Option Explicit

Public Function alleTeilerFinden(zahl)
   Dim lngCount As Long
   Dim Obergrenze As Long
   Dim lngIndex As Long
   ReDim arr(lngIndex)
   Obergrenze = zahl
   Do
       lngCount = lngCount + 1
       If lngCount >= Obergrenze Then Exit Do
       If zahl Mod lngCount = 0 Then
           lngIndex = lngIndex + 2
           ReDim Preserve arr(lngIndex - 1)
           arr(lngIndex - 2) = lngCount
           Obergrenze = zahl / lngCount
           arr(lngIndex - 1) = Obergrenze
       End If
   Loop
   alleTeilerFinden = Join(arr, "-")
End Function

[Ego]

Hallo Frank,

1. Warum schreibst du die Werte nicht direkt in ein zweidimensionales Array anstatt in einen String?

2. Du prüfst doch nicht wirklich, ob 240 durch Zahlen zwischen 121 und 239 oder zwischen 81 und 119 oder ... teilbar ist?
Die Obergrenze ist Abrunden(Wurzel(zahl)) und man hat bei jedem Treffer zwei Teiler. Anstatt 240 müssen nur 15 Prüfungen auf Teilbarkeit durchgeführt werden.

[Ego]

Bitte sehr:

[F r a n k]

Hallo Helmut,

zu deiner ersten Antwort,

1. hört sich alles gut an nur leider keine Ahnung wie ich dies umsetzen sollte. Alle Versuche kamen nie zu einem funktionierenden Ergebnis.
2. mmmm, keine Ahnung, ist zusammengebastelt / kopiert aus dem www, war meinem Ziel so am nächsten.

zu deiner zweiten Antwort

DANKE :18:

jetzt versuch ich die nur noch zu verstehen und auszukomentieren.

[Ego]

Hallo  Frank,

sorry.

1. Ich hab mich in meinem Programm beim zweiten Parameter der Funktion RoundDown vertan. Es muss 0 statt 1 sein. Das ändert zwar nichts am Ergebnis, sieht aber "schöner" aus.

2. Dein bisheriger Algorithmus prüft bei 240 auch nur die Zahlen von 1-15, aber bei Primzahlen unnützerweise alle Zahlen bis n-1.

[F r a n k]

Hallo Helmut,

Parameter hab ich angepasst, jetzt hab ich noch folgendes Problem:

der Code überschreibt alle anderen Zellen wenn diese vorher beschrieben waren.
Und wenn Auswahl und Teiler in benachbarten Zellen also A1 und B1 z.B stehen wird die Auswahl geleert.
Die Auswahl wird auch geleert wenn eine beliebige andere Zelle vorher beschrieben war. Ist alles leer funzt es ohne Probleme.

[Ego]

Hallo Frank,

1. Ja, das ist richtig, das liegt an der Zeile:

Code:

Range("Teiler").CurrentRegion = ""

Da die Liste der neuen Zahl kürzer als die alte Liste sein kann, lösche ich sie vor dem Schreiben der neuen Liste. Und so geht es am einfachsten.
Lass einfach vor, hinter und über der Liste eine Spalte/Zelle frei.

2. Da die Teilerliste ja nur zur Auswahl der zweiten Zahl genutzt wird, würde ich sie auf ein anderes Blatt schreiben. (benannte Zelle verschieben)
Dann must du aber

Code:

        Range("Teiler").CurrentRegion = ""
        Range("Teiler").Resize(coll.Count, 1) = varTeiler

durch

Code:

        ThisWorkbook.Names("Teiler").RefersToRange.CurrentRegion = ""
        ThisWorkbook.Names("Teiler").RefersToRange.Resize(coll.Count, 1) = varTeiler

ersetzen.

[Storax]

Sicher, dass das keine Hausaufgabe ist, etwas ausgeschmückt zwar, aber grundsätzlich geht es doch um dies hier :19:

[snb]

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Value < 1 Or Target.Address <> "$A$1" Then Exit Sub
        
    y = Target
    c00 = "1 " & y
    For j = 3 To Application.RoundDown(y ^ 0.5, 1) Step Target Mod 2 + 1
        If y Mod j = 0 Then
            c00 = c00 & " " & j & " " & y / j
        End If
    Next
    sn = Split(c00)
    
    Application.EnableEvents = False
    Columns(5).ClearContents
    Cells(1, 5).Resize(UBound(sn) + 1) = Application.Transpose(sn)
    Application.EnableEvents = True
End Sub