Jasno i primenjeno
Code:
Dim Niz As Variant
Dim n As Integer
Dim k As Integer
Public Sub Main()
Dim TG As Variant
Dim elem As Single
Dim i As Integer
Dim MinElem As Integer
Dim komb As String
k = 1
n = 6
komb = ""
Niz = Array(1, 4, 6, 7, 8, 9)
Stampaj Niz
TG = Niz
Do While NextGroup(Niz, TG(n - 1)) And k < 20
k = k + 1
Stampaj Niz
Loop
End Sub
Public Function NextGroup(arr As Variant, ByVal elem As Integer) As Boolean
Dim i As Integer
Dim Gropu As Integer
Dim m As Integer
NextGroup = False
Group = n / 2 - 1
i = 2
Do
If arr(i) < elem Then
m = FindMin(arr, n - i, n, arr(n - i - 1))
If m = 0 Then
Else
Swap n - i - 1, m
SortArr arr, n - i
NextGroup = True
End If
End If
i = i + 2
Loop While i < n And Not NextGroup
End Function
Public Function FindMin(arr As Variant, ByVal start As Integer, ByVal kraj As Integer, ByVal element As Single)
Dim i As Integer
Dim min As Integer
Dim p As Integer
p = 0
For i = start To kraj - 1
If arr(i) > element Then
If p = 0 Then
p = i
min = arr(i)
Else
If arr(i) < min Then
min = arr(i)
p = i
End If
End If
End If
Next i
FindMin = p
End Function
Public Function Swap(ByVal l As Integer, ByVal r As Integer)
Dim t As Single
t = Niz(l)
Niz(l) = Niz(r)
Niz(r) = t
End Function
Public Sub SortArr(arr As Variant, ByVal start As Integer)
Dim strTemp As Single
Dim i As Long
Dim j As Long
Dim lngMin As Long
Dim lngMax As Long
lngMin = start
lngMax = UBound(arr)
For i = lngMin To lngMax - 1
For j = i + 1 To lngMax
If arr(i) > arr(j) Then
strTemp = arr(i)
arr(i) = arr(j)
arr(j) = strTemp
End If
Next j
Next i
Niz = arr
End Sub
Public Sub Stampaj(arr As Variant)
Dim komb As String
Dim i As Integer
komb = ""
For i = 1 To n
If i = 1 Then
komb = Val(Niz(i - 1))
ElseIf i Mod 2 = 0 Then
komb = komb & Val(Niz(i - 1))
Else
komb = komb & ", " & Val(Niz(i - 1))
End If
Next
Debug.Print k & ":", komb
End Sub
a evo ga i izlazni rezultat, bas onako kako mi je potrebno
Code:
1: 14, 67, 89
2: 14, 68, 79
3: 14, 69, 78
4: 16, 47, 89
5: 16, 48, 79
6: 16, 49, 78
7: 17, 46, 89
8: 17, 48, 69
9: 17, 49, 68
10: 18, 46, 79
11: 18, 47, 69
12: 18, 49, 67
13: 19, 46, 78
14: 19, 47, 68
15: 19, 48, 67