Ausgabe aller möglichen Zahlenkombinationen (Kofferschloss)

[Redgeier]

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

[snb]

Ersetzen reicht. Und dann testen. Die Zeile mit Msgbox löschen.

[EarlFred]

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 Sub

[Redgeier]

Perfekt! Danke für Deine Mühen!

Schönes Wochenende

LG

[snb]

Ohne Recursion,
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 Sub

Wenn 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 Sub

[hddiesel]

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.