Forum - Excel07 Επιλογή των 5 μεγαλυτερων αριθμών με βάση κριτηρίων

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [Excel07] Επιλογή των 5 μεγαλυτερων αριθμών με βάση κριτηρίων (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/6402-epilogi-ton-5-megalyteron-arithmon-me-basi-kritirion.html)

Επιλογή των 5 μεγαλυτερων αριθμών με βάση κριτηρίων

Καλησπέρα, στο αρχείο που επισυνάπτω υπάρχει μια στήλη με σκορ και μια με το ποσοστό του. Πως γίνεται να παίρνω τα 5 σκορ των 5 καλύτερων ποσοστών;

Καλημέρα Σάκη,

Δοκίμασε μια πρόταση με κώδικα VBA.

Θα πρέπει να είναι ενεργοποιημένες οι μακροεντολές για να λειτουργήσει το κουμπί ΠΕΝΤΑΔΕΣ.

Λειτουργεί τέλεια.Είναι ότι χρειαζόμουν.
Ευχαριστώ πολύ.

Τα δεδομένα μου περιορίζονται σε συγκεκριμένο range.
Αν θέλω να παίρνει ένα συγκεκριμένο διάστημα πχ από w6:at34(AY η στήλη που θα παίρνω τα δεδομένα) και όχι όλες τις γραμμές πως μπορεί να διαμορφωθεί ο κώδικας;
Τώρα από ότι μπορώ να καταλάβω παίρνει όλες τις γραμμές από πχ B και έπειτα
Dim I As Long, R As Long, C As Byte
R = Range("B" & Rows.Count).End(xlUp).Row
Range("P4:P" & R).ClearContents

Application.ScreenUpdating = False
For I = 4 To R
For C = 1 To 7
Range("R" & C & ":S" & C).Value = Range(Cells(I, 2 * C), Cells(I, 2 * C + 1)).Value
Next

[R1:S7].Sort Key1:=[S1], Order1:=xlDescending, Header:=xlNo
Range("P" & I).Value = WorksheetFunction.Sum([R1:R5])
[R1:S7].ClearContents
Next
Application.ScreenUpdating = True

Καλημέρα Σάκη,

1. Τα αθροίσματα των αποτελεσμάτων θα εμφανίζονται στη στήλη ΑΥ βάσει των πέντε καλύτερων ποσοστών γραμμής.
2. Ως δικλείδα ασφαλείας, το επιλεγμένο εύρος θα πρέπει να έχει όριο 250 γραμμών, 50 στηλών και πάντα ζυγό αριθμό στηλών. Φυσικά τα όρια αυτά αλλάζουν με τις ανάλογες τροποποιήσεις στον κώδικα.
3. Αφού επιλέξουμε το εύρος με τα δεδομένα μας (βλ. 2), πατάμε το κουμπί ΠΕΝΤΑΔΕΣ.

Σύμφωνα λοιπόν με τα παραπάνω, δοκίμασε τον παρακάτω κώδικα αν καλύπτει το ζητούμενό σου:

Κώδικας:

Option Explicit
 

Sub PENTADES()

    Dim Rng As Range

    Set Rng = Selection

    

    If Rng.Rows.Count > 250 Or Rng.Columns.Count > 50 Or Rng.Columns.Count Mod 2 <> 0 Then

        MsgBox "Λανθασμένο εύρος δεδομένων!", vbCritical, "ΣΦΑΛΜΑ"

        Exit Sub

    End If

    

    Dim R As Integer, X As Integer, C As Byte, Y As Byte, R1 As Integer

    [AY:AY,BA:BB].ClearContents

    X = Rng.Row + Rng.Rows.Count - 1

    Y = Rng.Column + Rng.Columns.Count - 1

    

    Application.ScreenUpdating = False

    For R = Rng.Row To X

        R1 = R

        For C = Rng.Column To Y Step 2

            Range("BA" & R1 & ":BB" & R1).Value = Range(Cells(R, C), Cells(R, C + 1)).Value

            R1 = R1 + 1

        Next

        

        [BA:BB].Sort Key1:=[BB1], Order1:=xlDescending, Header:=xlNo

        Range("AY" & R).Value = Evaluate("SUM(BA1:BA5)")

        [BA:BB].ClearContents

    Next

    Application.ScreenUpdating = True

End Sub

Xρήστο πως επιλέγω αυτό που γράφεις"(βλ.2)";
"Αφού επιλέξουμε το εύρος με τα δεδομένα μας (βλ. 2), πατάμε το κουμπί ΠΕΝΤΑΔΕΣ."

Προσπάθησα να το προσαρμόσω στο δικό μου αρχείο όπου έχω range δεδομένων w6:at34 αλλά δεν τα κατάφερα....μου βγάζει το μνμ "Λανθασμένο ευρος".
Βασικά ότι και αν έχω βάλει μου βγάζει αυτό το μνμ.

Σάκη,

Μαρκάρεις με το ποντίκι το εύρος που θέλεις και μετά απλά πατάς το κουμπί ΠΕΝΤΑΔΕΣ. Στη συνέχεια, τα αποτελέσματα θα εμφανιστούν στη στήλη ΑΥ ακριβώς στις γραμμές του επιλεγμένου εύρους.

Επομένως στην περίπτωσή σου, αν επιλέξεις με το ποντίκι το εύρος W6:AT34 και πατήσεις ΠΕΝΤΑΔΕΣ, στην περιοχή ΑΥ6:ΑΥ34 λογικά θα εμφανιστούν τα αθροίσματα.

Ωωωωωω τρομερό.Τέλειο. Δουλεύει τέλεια και είναι και πολύ χρηστικό.