Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1192to1196
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

Makro anpassen

Makro anpassen
alifa
Hallo,
wie kann man dieses Makro ändern, damit nur die Kombinationen ausgedruckt werden, deren Summe
421 ist? Z.B. 19+23+71+151+157=421

Option Explicit
Sub KombiMagi6_1()
Dim i As Long, u As Double, lngR As Long
Dim n As Byte, k As Byte, j As Byte
Dim vSrc, t!
t = Timer
'Einträge:
vSrc = Array(19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, _
79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157)
k = 5
n = UBound(vSrc) + 1
If k > n Then MsgBox "k > n", 16: Exit Sub
With Application
u = .Fact(n) / (.Fact(k) * .Fact(n - k))
End With
If u > Rows.Count Then MsgBox u & " > " & Rows.Count, 16: Exit Sub
ReDim vRes(k - 1)
ReDim bPos(k - 1) As Byte
For i = 1 To k
bPos(i - 1) = i
Next
Application.ScreenUpdating = False
With ActiveSheet
.Cells.Delete
For i = 1 To u
lngR = lngR + 1
For j = 0 To UBound(bPos)
vRes(j) = vSrc(bPos(j) - 1)
Next
.Range(.Cells(lngR, 1), .Cells(lngR, k)).Value = vRes
Call GetComb(n, k, bPos)
Next
End With
Application.ScreenUpdating = True
MsgBox "fertig in " & Round(Timer - t, 2) & " Sek "
End Sub
Sub GetComb(ByVal n As Byte, ByVal k As Byte, bPos() As Byte)
Dim i As Byte, j As Byte
i = k - 1
Do While bPos(i) >= n - k + i + 1
If i = 0 Then Exit Do
i = i - 1
Loop
bPos(i) = bPos(i) + 1
For j = i To k - 1
bPos(j) = bPos(i) + j - i
Next
End Sub

Danke im Voraus
Alifa

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro anpassen
03.01.2011 17:32:02
Christian
hallo Alifa,
zB. so
...
For i = 1 To u
lngSum = 0
For j = 0 To UBound(bPos)
vRes(j) = vSrc(bPos(j) - 1)
lngSum = lngSum + vRes(j)
Next
If lngSum = 421 Then
lngR = lngR + 1
.Range(.Cells(lngR, 1), .Cells(lngR, k)).Value = vRes
End If
Call GetComb(n, k, bPos)
Next
...
und natürlich zuvor lngSum deklarieren.
Gruß
Christian
AW: Makro anpassen
03.01.2011 18:42:37
alifa
Hallo Christian,
das klappt ausgezeichnet! in 0,53 Sek.
Diese 1367 Kombinationen sollen jetzt so geordnet werden, dass ein magisches Quadrat 6-er Ordnung entsteht. Die fehlenden 6 Zahlen werden mit Nullen ersetzt. In jede der 6 Spalten eine Null und 5 Zahlen(eine von den 1367 Kombinationen). Für alle 6 Zeilen und die beiden Hauptdiagonalen gilt das Gleiche. Die Position der Nullen kann frei gewählt werden. Diese können evt. auch zwischen die Zahlen geraten. Ich weiß, es ist nicht einfach, vielleicht hat jemand eine Idee...
VG
alifa
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige