Microsoft Excel

Herbers Excel/VBA-Archiv

Prozedur für Ergebnisse ohne Permutationen

Betrifft: Prozedur für Ergebnisse ohne Permutationen von: Alifa
Geschrieben am: 08.08.2014 11:38:10

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

  

Betrifft: AW: Prozedur für Ergebnisse ohne Permutationen von: Arthur
Geschrieben am: 08.08.2014 13:47:37

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


  

Betrifft: AW: Prozedur für Ergebnisse ohne Permutationen von: Alifa
Geschrieben am: 09.08.2014 07:31:13

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



  

Betrifft: Kombinationen mit Zurücklegen von: cross
Geschrieben am: 09.08.2014 10:27:14

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) < nn Then
      intVal = ar(ii, lngSp) + 1
      For jj = lngSp To kk
         ar(ii, jj) = intVal
      Next jj
   Else
      arInc ar, ii, nn, kk, lngSp - 1
   End If
End Subb
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!


  

Betrifft: AW: Kombinationen mit Zurücklegen von: Alifa
Geschrieben am: 09.08.2014 11:03:09

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


  

Betrifft: ..noch immer " cross " ? owT ;-) von: robert
Geschrieben am: 09.08.2014 12:51:04




 

Beiträge aus den Excel-Beispielen zum Thema "Prozedur für Ergebnisse ohne Permutationen"