Prozedur für Ergebnisse ohne Permutationen

Forumthread: Prozedur für Ergebnisse ohne Permutationen

08.08.2014 11:38:10

Alifa

Hallo,
mit den Zahlen 1,3,7,9 sollen alle sechsstelligen Zahlen gebildet werden, deren Quersumme 10, 20 oder 30 ist. Dabei sollen keine Permutationen gebildet werden. Beispiel:111133,111179,133779. Permutationen wie, 113113,179111 usw sollen nicht angezeigt werden. Danke im Voraus
Gruß, Alifa

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Prozedur für Ergebnisse ohne Permutationen

08.08.2014 13:47:37

Arthur

Hi Alifa.
Denke, dass das in VBA geht. Ohne Permutation die Schleifenvariablen einfach nicht weiter laufen lassen.
Gruß, Arthur

AW: Prozedur für Ergebnisse ohne Permutationen

09.08.2014 07:31:13

Alifa

Das ist mein Makro. Kann mir jemand im Sinne der Aufgabe helfen?
Danke im Voraus, Alifa


Sub OhnePermutationen()
Dim a, b, c, d, e, f, n, p, z&
p = Array(1, 3, 7, 9)
Columns.ClearContents
For Each a In p
For Each b In p
For Each c In p
For Each d In p
For Each e In p
For Each f In p
n = a + b + c + d + e + f
If n = 10 Or n = 20 Or n = 30 Then
z = z + 1
Cells(z + 2, 1).Resize(, 6) = Array(a, b, c, d, e, f)
End If: Next: Next: Next: Next: Next: Next a
Columns.AutoFit
End Sub

Kombinationen mit Zurücklegen

09.08.2014 10:27:14

cross

Hi Erhard,
da habe ich wohl etwas für dich gefunden:


Sub TestIt()
Dim nn As Integer, kk As Integer, arE, arN, arK, ee As Long, ss As Long
arK = Array(1, 3, 7, 9)
arE = KombisMitZurueck(4, 6)
ReDim arN(1 To UBound(arE), 1 To 6)
For nn = 1 To UBound(arE)
ss = 0
For kk = 1 To 6
ss = ss + arK(arE(nn, kk) - 1)
Next kk
If ss = 10 Or ss = 20 Or ss = 30 Then
ee = ee + 1
For kk = 1 To 6
arN(ee, kk) = arK(arE(nn, kk) - 1)
Next kk
End If
Next nn
Cells(2, 1).Resize(ee, 6) = arN
End Sub
Function KombisMitZurueck(ByVal nn As Long, ByVal kk As Integer)
Dim ar As Variant, ii As Long, jj As Integer, lngSize As Long
lngSize = WorksheetFunction.Combin(nn - 1 + kk, kk)
ReDim ar(1 To lngSize, 1 To kk)
For jj = 1 To kk
ar(1, jj) = 1
Next jj
For ii = 2 To lngSize
For jj = 1 To kk
ar(ii, jj) = ar(ii - 1, jj)
Next jj
arInc ar, ii, nn, kk, kk
Next ii
KombisMitZurueck = ar
End Function
Sub arInc(ar, ByVal ii As Long, ByVal nn As Integer, ByVal kk As Integer, _
ByVal lngSp As Integer)
Dim intVal As Integer, jj As Integer
If ar(ii, lngSp)

Eine Quelle:
https://www.herber.de/forum/archiv/1000to1004/1001022_Kombinationen_mit_Zuruecklegen_ohne_Reihenfolge.html
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich und: Schönes Wochenende allerseits!

AW: Kombinationen mit Zurücklegen

09.08.2014 11:03:09

Alifa

Hi Erich,
hatte an New Collection gedacht. Dein Test zeigt alle Möglichkeiten. Ich hatte "zu Fuß" 10 gefunden. Doch ,siehe da, es gibt 11. Vielen Dank und ein schönes Wochenende aus dem Oberbergischen, Erhard

..noch immer " cross " ? owT ;-)

09.08.2014 12:51:04

robert

Beliebteste Forumthreads (12 Monate)

Prozedur für Ergebnisse ohne Permutationen

Forumthread: Prozedur für Ergebnisse ohne Permutationen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread