Anzeige
Archiv - Navigation
1152to1156
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

10 AUS 30

10 AUS 30
Walter
Guten Morgen Excelfreunde,
Ich möchte die Kombinationen von 10 Zahlen aus 30 Zahlen erstellen.
Wenn die 4 mal zweite Zahl um 1 Größer als die erste Zahl ist, soll die Zeile gelöscht werden
Etwa so: 1,3,8,9,10,11,12,20,22,23 soll gelöscht werden.
Dazu hat mir ein Freund diese Makro geschrien, und ich bekomme es nicht zum Laufen.
(Mein Freund ist irgendwo im Urlaub)
Option Explicit
Sub GetPattern()
Dim vPtrn, lngR As Long, lngLR As Long
Dim i As Integer, intC As Integer
Dim k As Byte, n As Byte, m As Byte, bFrst As Byte
'Einträge:
k = 10
n = 30
bFrst = 1  'erste Zahl
If k > n Then MsgBox "k > n", 10: Exit Sub
intC = 1
ReDim vPtrn(1 To k)
For i = 1 To k
vPtrn(i) = bFrst + i - 1
Next
Application.ScreenUpdating = False
With Sheets(1)
.Cells.Delete
lngLR = .Rows.Count
Do While vPtrn(1) = bFrst
If lngR = lngLR Then lngR = 0: intC = intC + k + 1
lngR = lngR + 1
.Range(.Cells(lngR, intC), .Cells(lngR, intC + k - 1)).Value = vPtrn
m = k
Do While vPtrn(m) >= n - k + m
If m = 1 Then Exit Do
m = m - 1
Loop
vPtrn(m) = vPtrn(m) + 1
For i = m + 1 To k
vPtrn(i) = vPtrn(m) + i - m
Next
Loop
End With
Application.ScreenUpdating = True
End Sub

Sub ZeilenLoeschen()
Dim vnZ As Variant
Dim i As Long, x As Integer, y As Integer
Dim rngB As Range
Set rngB = Range("A1").CurrentRegion
Application.ScreenUpdating = False
For i = rngB.Cells.Count To 1 Step -1
vnZ = Split(rngB.Cells(i), ",")
If UBound(vnZ) = 5 Then
y = 1
For x = 0 To 4
If CInt(vnZ(x)) = CInt(vnZ(x + 1)) - 1 Then
y = y + 1
If y = 3 Then
rngB.Cells(i).Delete xlUp
Exit For
End If
ElseIf CInt(vnZ(x)) 
Bitte um Hilfe
Walter

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: 10 AUS 30
03.05.2010 12:02:05
fcs
Hallo Walter,
verschiedene Probleme:
A:
10 Zahlen aus 30 ergibt 30.045.015 Kombinationen. Diese Anzahl kannst du in Excel 2003 mit dem Makro nicht mehr vollständig in ein Tabellenblatt schreiben.
B:
Wenn die 4 mal zweite Zahl um 1 Größer als die erste Zahl ist, soll die Zeile gelöscht werden
Etwa so: 1,3,8,9,10,11,12,20,22,23 soll gelöscht werden.

Diese Logik kann ich nicht nachvollziehen.
Was willst du denn mit dieser "Zahlenspielerei" erreichen?
Gruß
Franz
AW: 10 AUS 30 vergessen!!
03.05.2010 12:51:04
Walter
Hallo Franz,
Wir wollten eine Art Pferderennen aufbauen.
Haben leider zu wenig überlegt und gerechnet.
C(k,r) =____k!____ 
r! (k-r)! 
30! 2,65253E+32 30.045.015
10!(30-10)! 3628800 2,4329E+18
Danke für Deinen hinweis
Walter
Anzeige
bestimmte Kombinationen 10 aus 30
03.05.2010 13:28:05
Erich
Hi Walter,
wenn du trotzdem viele solche Kombinationen haben möchtest - hier kannst du zusehen:
https://www.herber.de/bbs/user/69367.xls
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
AW: bestimmte Kombinationen 10 aus 30
03.05.2010 14:40:19
Walter
Hallo Erich,
Läuft fast gut, bei 1 11 13 14 18 20 22 24 27 29 macht er Schluss.
Liegt dies am Makro oder am PC?
Gruß Walter
Fehlermeldung?
03.05.2010 16:41:26
Erich
Hi Walter,
deine Angabe "bei 1 11 13 14 18 20 22 24 27 29 macht er Schluss" enthält nicht so recht die Infos,
die man für eine Antwort vielleicht bräuchte.
Soll ich wie du das Makro laufen lassen bis zu dieser Kombination, um zu sehen, was dann passiert?
In welche Spalte werden die letzten Werte geschrieben?
Wie "macht er Schluss"? Hört das Makro einfach auf zu laufen?
Gibt es eine Fehlermeldung?
Wenn ja: Welche, zu welcher Codezeile?
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Fehlermeldung?
03.05.2010 17:12:22
Walter
Hallo Erich,
Letzte Zelle ER65536, dann beendet er das Programm. Keine Fehlermeldung
Könnte man das Makro so schreiben, das erste Zahl 1, dann erste Zahl 2,...............erste Zahl 9
So müsste man 18 Tabellen erstellen.
Gruß
Walter
neue Version
03.05.2010 18:03:50
Erich
Hi Walter,
da waren noch ein paar handwerkliche Fehler drin.
Mit diesem Makro kannst du 19 (nicht 18) Blätter füllen - aber hübsch nacheinander...
Im Code gibst du jeweils die 1. Zahl für das Blatt vor:

Option Explicit
Sub GetPattern()
Dim vPtrn, lngR As Long, lngLR As Long
Dim i As Integer, intC As Integer
Dim k As Byte, n As Byte, m As Byte, bFrst As Byte
Dim ww As Byte, arrE(1 To 65536) As String
k = 10
n = 30
bFrst = 18                                'hier erste Zahl
If k > n Then MsgBox "k > n", 10: Exit Sub
intC = 0
ReDim vPtrn(1 To k)
For i = 1 To k
vPtrn(i) = bFrst + i - 1
Next
Application.ScreenUpdating = False
With Sheets(1)
.Cells.Delete
lngLR = .Rows.Count
Do While vPtrn(1) = bFrst
For ww = 1 To k - 4
If vPtrn(ww) + 4 = vPtrn(ww + 4) Then Exit For
Next ww
If ww > k - 4 Then
If lngR = lngLR Then
lngR = 0
intC = intC + 1
.Cells(1, intC).Resize(65536) = Application.Transpose(arrE)
Erase arrE
.Columns(intC).AutoFit
Application.ScreenUpdating = True
If intC > 4 Then ActiveWindow.SmallScroll ToRight:=1
Application.ScreenUpdating = False
End If
lngR = lngR + 1
arrE(lngR) = Join(vPtrn, " ")
End If
m = k
Do While vPtrn(m) >= n - k + m
If m = 1 Then Exit Do
m = m - 1
Loop
vPtrn(m) = vPtrn(m) + 1
For i = m + 1 To k
vPtrn(i) = vPtrn(m) + i - m
Next
DoEvents
Loop
If lngR > 0 Then
intC = intC + 1
.Cells(1, intC).Resize(lngR) = Application.Transpose(arrE)
.Columns(intC).AutoFit
End If
End With
Application.ScreenUpdating = True
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige