10 AUS 30
Walter
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 HilfeWalter