Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1372to1376
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Prozedur für Ergebnisse ohne Permutationen

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

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

Betreff
Datum
Anwender
Anzeige
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

Anzeige
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!

Anzeige
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)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige