[VBA] κώδικας κατασκευής συνδυασμών αριθμών

[Δημήτριος57]

Φίλοι του Forum γεια σας.
Έχω τον πιο κάτω κώδικα vba.

Sub Combinations()
Dim n As Integer, m As Integer, numcomb
numcomb = 0
n = InputBox("Number of items?", "Combinations")
m = InputBox("Taken how many at a time?", "Combinations")
Application.ScreenUpdating = False
Comb2 n, m, 1, ""
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Private Function Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String)
If m > n - k + 1 Then Exit Function
If m = 0 Then
ActiveCell = s
ActiveCell.Offset(1, 0).Select
Exit Function
End If
Comb2 n, m - 1, k + 1, s & k & " "
Comb2 n, m, k + 1, s
End Function

Θα ήθελα να ρωτήσω, αν αυτή η Function μπορεί να τροποποιηθεί, έτσι ώστε να αναγράφει το αποτέλεσμα σε ξεχωριστά συνεχόμενα κελιά. π.χ. Αντί για "1 2 3 4 5" στο κελί A1, να το αναγράφει στα κελιά A1,A2,A3,A4,A5

Ευχαριστώ πολύ, για όποια απάντηση.

[Spirosgr]

Δοκίμασα με επιλεγμένο το Α1
n=5 & m=1
ακόμα με n=10 & m=2

Τρέχουμε το Combinations και
το αποτέλεσμα αναπτύσσεται στα κελιά a1,a2...aν όσο πρέπει...
Ποιό είναι το πρόβλημα;

[Δημήτριος57]

Το πρόβλημα είναι κατ' αρχήν δικό μου, γιατί κατά λάθος έγραψα τα κελιά A1,A2,A3,A4,A5 αντί να γράψω A1,B1,C1,D1,E1, και ζητώ συγνώμη για το λάθος μου. Αυτό που θέλω τελικά είναι να εμφανίζετε σε ξεχωριστό κελί (οριζόντια) ο κάθε αριθμός του ίδιου συνδυασμού. π.χ. αν εμφανίζετε ο συνδυασμός "1,2,3,4,5" στο κελί A1, εγώ θέλω να εμφανίζετε ως εξής. A1=1,B1=2,C1=3,D1=4,E1=5.

[kapetang]

Καλημέρα

Δημήτρη αυτό γίνεται, αλλά δημιουργεί προβλήματα.

Βλέπω ότι έχεις το office 2003, στο οποίο το πλήθος των στηλών είναι 256.

Αν θέλουμε τους συνδυασμούς των n ανά m, σε μία γραμμή, μπορούμε να καταχωρήσουμε το πολύ 256/m συνδυασμούς, που είναι πολύ λίγοι.

Αν έχουμε παραπάνω συνδυασμούς, που θα καταχωρηθούν;

Στις παρακάτω γραμμές;

[Δημήτριος57]

Καλημέρα Γιώργο, και ευχαριστώ για την απάντηση.
1) Έχω το Excel 2007
2) Oi 'n' αριθμοί θα είναι έως 30 το πολύ. Οι 'm' αριθμοί θα είναι από 5 έως 6
Παράδειγμα συνδυασμού με 'n' = 7 και 'm' = 5 (Συνημμένο αρχείο)
3) Αν υπάρχει πρόβλημα σε κάτι, αυτό είναι το πλήθος των γραμμών, και όχι των στηλών
(για μεγάλο αριθμό συνδυασμών).

[kapetang]

Δημήτρη τώρα κατάλαβα τι θέλεις.

Δοκίμασε τον κώδικα:

Option Explicit
Dim x() As Variant, R As Long, mm As Long
Sub Combinations()
    Const startCel As String = "A1" 'Το κελί στο οποίο θα γίνει η 1η καταχώρηση
    Dim n As Integer, m As Integer, numcomb, rng As Range, numC As Long
    
    numcomb = 0
    n = InputBox("Number of items?", "Combinations")
    m = InputBox("Taken how many at a time?", "Combinations")
    mm = m
    Application.ScreenUpdating = False
    numC = Application.WorksheetFunction.Combin(n, m)
    Set rng = Range(startCel)
    ReDim x(1 To numC, 1 To m) As Variant
    R = 0
    Comb2 n, m, 1, ""
    rng.Resize(UBound(x, 1) + 5, mm + 2).ClearContents
    rng.Resize(UBound(x, 1), mm).Value = x
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Private Function Comb2(ByVal n As Integer, ByVal m As Integer, _
                       ByVal k As Integer, ByVal s As String)
    Dim j As Long
    If m > n - k + 1 Then Exit Function
    If m = 0 Then
        R = R + 1
        For j = 1 To mm
            x(R, j) = Split(s, " ")(j - 1)
        Next
        Exit Function
    End If
    Comb2 n, m - 1, k + 1, s & k & " "
    Comb2 n, m, k + 1, s
End Function

[Δημήτριος57]

Γιώργο.....αυτό είναι!!!
Ευχαριστώ πολύ.

[kapetang]

Καλή συνέχεια Δημήτρη.

[kapetang]

Δημήτρη, για να κάνουμε σωστή δουλειά, άλλαξε την ομώνυμη ρουτίνα του προηγούμενου κώδικα με την :

Sub Combinations()
    Const startCel As String = "A1"    'Το κελί στο οποίο θα γίνει η 1η καταχώρηση
    Dim n As Integer, m As Integer, rng As Range, numCbn As Long

    n = InputBox("Number of items?", "Combinations")
    m = InputBox("Taken how many at a time?", "Combinations")
    mm = m
    Application.ScreenUpdating = False
    numCbn = Application.WorksheetFunction.Combin(n, m)
    If numCbn >= Rows.Count - 2 - Range(startCel).Row Then
        MsgBox "Το πλήθος των συνδυασμών: " & Format(numCbn, "#,###") & vbCrLf & _
               "υπερβαίνει το πλήθος των γραμμών του φύλλου", vbCritical
    Else
        Set rng = Range(startCel)
        ReDim x(1 To numCbn, 1 To m) As Variant
        R = 0
        Comb2 n, m, 1, ""
        rng.Resize(UBound(x, 1) + 2, mm + 2).ClearContents
        rng.Resize(UBound(x, 1), mm).Value = x
    End If
End Sub

Στον κώδικα ελέγχεται αν το πλήθος των συνδυασμών είναι μικρότερο από το πλήθος των γραμμών του φύλλου και αν δεν είναι εμφανίζεται μήνυμα και οι συνδυασμοί δεν υπολογίζονται

Χωρίς τον έλεγχο θα υπολογίζονταν οι συνδυασμοί (θα απαιτούσε κάποιο χρόνο) και ο κώδικας θα χτυπούσε..

[Δημήτριος57]

Γιώργο καλημέρα
Επανέρχομαι στο θέμα, για μια σημαντική βελτίωση της ρουτίνας, αν αυτό είναι εφικτό.
Τελικά ....όπως το λες. Βγάζει error overflow ή out of memory, όταν βάζω πολλούς αριθμούς για δημιουργία συνδυασμών.
Αναρωτιέμαι αν αυτό μπορεί να εξαλειφθεί, αν υπολογίζει και εμφανίζει έναν συνδυασμό στην ίδια θέση κάθε φορά, π.χ. ξεκινώντας πάντα κάθε συνδυασμό από το κελί "A1" και όχι να κρατά στη μνήμη όλους τους συνδυασμούς, και να τους εμφανίζει όλους μαζί, με αποτέλεσμα το overflow ή out of memory.
Αυτό θα ήταν τέλειο.
Για να καταλάβεις καλύτερα τι θέλω να κάνω, σου στέλνω αυτό το αρχείο, που μου δίνει κάποια στατιστικά δεδομένα των 'χ' τελευταίων κληρώσεων για το παιχνίδι του ΟΠΑΠ 'ΤΖΟΚΕΡ'.
Στο φύλλο αυτό, και στο κελί 'B8' τον αριθμό των τελευταίων 'χ' κληρώσεων από τις οποίες θέλω να πάρω στατιστικά στοιχεία.
Επεξήγηση του προγράμματος
Στις στήλες C:G είναι οι κληρώσεις.
Στις στήλες KH:KQ από τη γραμμή 12 και κάτω, εμφανίζει αν έχουμε πιάσει 0 ή 1 ή 2 ή 3 ή 4 ή 5 αριθμούς από την αντίστοιχη κλήρωση της ίδιας γραμμής, σε συνδυασμό με τούς επιλεγμένους αριθμούς της περιοχής IX1:JI10.
Κάθε χρωματική αλλαγή στις γραμμές 1 έως 10 αφορά διαφορετικές αριθμοσειρές, που τα αποτελέσματα τις στατιστικής ανάλυσης για κάθε αριθμοσειρά φαίνονται στην αντίστοιχη στήλη ίδιου χρώματος.
Στην περιοχή KH1:KQ6 εμφανίζονται τα συγκεντρωτικά αποτελέσματα τις στατιστικής ανάλυσης για κάθε αριθμοσειρά. π.χ στο κελί 'KQ6' εμφανίζει το πόσες φορές βγήκε 5αρη για την αριθμοσειρά της γραμμής 1 (με μπλε σκούρο χρώμα).
Για να καταλάβεις καλύτερα, μπορείς να αλλάξεις, ή να προσθέσεις ή να αφαιρέσεις κάποιους αριθμούς από κάποια αριθμοσειρά, και να δεις τα αποτελέσματα.
Σημείωση:
Τα πολλά κενά κελιά μεταξύ κληρώσεων και στατιστικών δεδομένων, οφείλονται στο ότι διέγγραψα όλα τα υπόλοιπα στατιστικά στοιχεία, για καλύτερη κατανόηση του προγράμματος.

Αυτό που θέλω να κάνει η ρουτίνα combinations.
1) Να εμφανίζει έναν συνδυασμό κάθε φορά, ξεκινώντας από το κελί 'IX1'
2) Να περιμένει μέχρι να γίνει ο υπολογισμός των συναρτήσεων στο φύλλο
3) Να διαβάζει την τιμή του κελιού 'KQ6", και να την συγκρίνει με την προηγούμενη τιμή του ίδιου
κελιού. Κάθε φορά που η τιμή του κελιού 'KQ6" είναι μεγαλύτερη από την τιμή πού έχει στη μνήμη
η ρουτίνα, να αντιγράφει την αριθμοσειρα της περιοχής 'IX1:KF1' στην περιοχή 'IX11:KF11', και στο κελί 'KG11' να αναγράφει την αντίστοιχη τιμή του κελιού 'KQ6". ΄
Με τον τρόπο αυτό θα έχω στην περιοχή 'IX11:KF11' τον καλύτερο συνδυασμό που έχει προκύψει, για την συγκεκριμένη αριθμοσειρά.

Ελπίζω να έγινα πιο σαφείς αυτή τη φορά, και φυσικά ελπίζω στη βοήθειά σας.

Υ.Γ. Καταλαβαίνω ότι ο χρόνος εκτέλεσης της ρουτίνας θα είναι πολύ μεγάλος, αλλά δεν με πειράζει.