24.11.2023, 12:35
Hallo! Soll dieser Code einen vorherigen ersetzen oder muss ich ihn einfach einfügen?
Ginge auch Rad 1 (2-4), Rad 2 (7-12) und Rad 3 (3-7)?
Danke
Ginge auch Rad 1 (2-4), Rad 2 (7-12) und Rad 3 (3-7)?
Danke
24.11.2023, 12:35
24.11.2023, 13:17
Ersetzen reicht. Und dann testen. Die Zeile mit Msgbox löschen.
26865
24.11.2023, 13:22
Code:
Option Explicit
Sub Kombinationen()
Dim Rädchen_oben As Variant
Dim Rädchen_unten As Variant
'Rad 1 (2-4), Rad 2 (7-12) und Rad 3 (3-7)?
Rädchen_oben = Array(4, 12, 7)
Rädchen_unten = Array(2, 7, 3)
Range("A:A").ClearContents
Range("A1").Value = "Kombinationen"
ReDim erg(0 To UBound(Rädchen_oben))
Call RecLoop(Rädchen_oben, Rädchen_unten, erg)
End Sub
Sub RecLoop(ByVal Rädchen_oben, ByVal Rädchen_unten, ByRef erg As Variant)
Dim i As Long
Dim f_o As Variant: f_o = Rädchen_oben
Dim f_u As Variant: f_u = Rädchen_unten
Dim blnEnde As Boolean
If UBound(Rädchen_oben) > 0 Then
ReDim Preserve f_o(0 To UBound(f_o) - 1)
ReDim Preserve f_u(0 To UBound(f_u) - 1)
Else
blnEnde = True
End If
For i = Rädchen_unten(UBound(Rädchen_unten)) To Rädchen_oben(UBound(Rädchen_oben))
erg(UBound(Rädchen_oben)) = i
If Not blnEnde Then Call RecLoop(f_o, f_u, erg)
If blnEnde Then Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = "'" & Join(erg, "-")
Next i
End Sub24.11.2023, 14:22
Perfekt! Danke für Deine Mühen!
Schönes Wochenende
LG
Schönes Wochenende
LG
24.11.2023, 15:59
Ohne Recursion,
Alles im Arbeitsspeicher (Array) (schneller): nur 1 Zugriff zum Arbeitsblatt.
Wenn die Utergrenze >0 ist:
Alles im Arbeitsspeicher (Array) (schneller): nur 1 Zugriff zum Arbeitsblatt.
Code:
Sub M_snb()
sn = Array(8, 14, 10)
ReDim sp(sn(0) * sn(1) * sn(2), 0)
For j = 0 To UBound(sp) - 1
sp(j, 0) = j \ (sn(1) * sn(2)) & "_" & (j \ sn(2)) Mod sn(1) & "_" & j Mod sn(2)
Next
Cells(1).Resize(UBound(sp)) = sp
End SubWenn die Utergrenze >0 ist:
Code:
Sub M_snb()
sn = Array(8, 14, 10) ' bis
sq = Array(2, 7, 3) ' von
sn(0) = sn(0) - sq(0)
sn(1) = sn(1) - sq(1)
sn(2) = sn(2) - sq(2)
ReDim sp(sn(0) * sn(1) * sn(2), 0)
For j = 0 To UBound(sp) - 1
sp(j, 0) = j \ (sn(1) * sn(2)) + sq(0) & "_" & (j \ sn(2)) Mod sn(1) + sq(1) & "_" & j Mod sn(2) + sq(2)
Next
Columns(1).ClearContents
Cells(1).Resize(UBound(sp) + 1) = sp
End Sub24.11.2023, 17:13
Hallo Redgeier,
am schnellsten geht es bei einem manuellen Zahlenschloss, mit etwas Fingerspitzengefühl und der von Gast 123 vorgeschlagenen Methode, mit etwas Kriechöl noch etwas schneller.
am schnellsten geht es bei einem manuellen Zahlenschloss, mit etwas Fingerspitzengefühl und der von Gast 123 vorgeschlagenen Methode, mit etwas Kriechöl noch etwas schneller.