[Γενικά] Δημιουργια λιστας απο πινακα

[comsup]

Καλησπερα, ειναι πιθανο να υπαρχει ηδη το θεμα, αλλα δεν καταφερα να το εντοπισω, όσο πισω κ αν εψαξα στο φορουμ.
Το προβλημα μου ειναι απλο στη διατυπωση. Εχω εναν πινακα ποδοσφαιριστων με πεδια (αριθμος, θεση, ημερομηνια γεννησης κλπ). Θελω να δημιουργησω 4 υποπινακες που να περιεχουν ξεχωριστα τους Τερματοφυλακες, αμυντικους, Μεσους, Επιθετικους. Εννοειται οτι στην εισαγωγη δεδομενων δινω τις τιμες GK DF MF AT μόνο.
Ευχαριστω!
Δημήτρης

[kapetang]

Καλημέρα

Στο συνημμένο έχω δημιουργήσει την παρακάτω (Categories) μακροεντολή, η οποία δημιουργεί 4 φύλλα με τις κατηγορίες (ανάλογα με τη θέση) των ποδοσφαιριστών.

Public Sub Categories()
    Dim rng As Range, i As Long, c As Variant, cat As Variant
    cat = Array("GK", "DF", "MF", "AT")
    
    Application.ScreenUpdating = False
    
    'Διαγραφή παλιών φύλλων
    On Error Resume Next
    For Each c In cat
        Worksheets(c).Delete
    Next
    On Error GoTo 0
    
    'Δημιουργία φύλλων και πινάκων
    For Each c In cat
        Sheets("EVALUATION1").Copy after:=Sheets(Sheets.Count)
        
        With ActiveSheet
            .Name = c
            Set rng = .Range("e13", .Cells(13, Cells.Columns.Count).End(xlToLeft))
        End With
        
        For i = rng.Columns.Count To 1 Step -1
            If rng(i) <> c Then
                rng(i).EntireColumn.Delete
            End If
        Next
                
    Next
              
End Sub

Για την εκτέλεση της μακροεντολής, στην καρτέλα Προγραμματιστής πατούμε το κουμπί Μακροεντολές για να ανοίξει το σχετικό πλαίσιο επιλογής και εκτέλεσης.

Οι μακροεντολές πρέπει να είναι ενεργοποιημένες.

[comsup]

1k ευχαριστω, ή καλυτερα να πω 1024 ευχαριστω για να ειμαι στο κλιμα. Περιμενα μια λιγοτερο λειτουργικη λυση με πολυπλοκο κωδικα. Και βλεπω μια τελεια λυση με λιγες μελετημενες γραμμες κωδικα. Εννοειται οτι θα το χρησιμοποιησω οπως ειναι, απλα τωρα μπαινω σε πειρασμο να προσθεσω κ αλλα πραγματα στο αρχειο που δεν φανταζομουν οτι μπορει να χρειαστω. Επειδη ασχολουμαι πολυ σοβαρα με ηλικιες στην υποδομη του ποδοσφαιρου με ενδιαφερει να παρακολουθω την εξελιξη τους, και ενα καλο τετοιο αρχεια θα με βοηθησει απιστευτα.
Έκανα επεξεργασια του μηνυματος μου γιατι διαπιστωσα πως με τις οδηγιες που ειχα γραψει στο πρωτο μηνυμα δεν ημουν ακριβής. Ανεβασα το αρχειο σε συμπιεσμενα τμηματα για να μπορω να εξηγησω ακριβως τι θα ηθελα.
Καθε φορα που εκτελω την μακροεντολη Positions (μετονομασια της categories) διαγραφονται τα φυλλα GK, DF, MF, AT και δημιουργουνται παλι. Ολα γινονται σωστα. Το προβλημα ειναι οτι τα στοιχεια που προκυπτουν εντος αυτων των φυλλων τα χρησιμοποιω στο φυλλο PLAYERSTATS το οποιο εχει σκοπο την συγκριση στοιχειων παικτων ιδιας θεσης στο γηπεδο. Άρα η εστω κ προσωρινη διαγραφη τους δημιουργει αναφορες #REF.
Επισης στη δημιουργια των φυλλων GK DF MF AT υπαρχει προβλημα με τις φωτογραφιες. Στο παραδειγμα που ειχα ανεβασει δεν ειχα βαλει κ τις φωτογραφιες, συγνωμη για την παραλειψη.

[kapetang]

Καλημέρα

Άλλαξε τον κώδικα με τον παρακάτω:

Public Sub POSITIONS()
    Dim rng As Range, i As Long, c As Variant
    Dim cat As Variant, S As Shape, str As String
    cat = Array("GK", "DF", "MF", "AT")

    Application.ScreenUpdating = False

    'Διαγραφή παλιών φύλλων
    On Error Resume Next
    Application.DisplayAlerts = False
    For Each c In cat
        Worksheets(c).Delete
    Next
    Application.DisplayAlerts = False
    On Error GoTo 0



    'Δημιουργία φύλλων και πινάκων
    For Each c In cat
        Sheets("EVALUATION").Copy after:=Sheets(Sheets.Count)

        With ActiveSheet
            For Each S In .Shapes
                If S.TopLeftCell.Column >= 5 Then
                    S.Name = S.TopLeftCell.Address(0, 0, xlA1)
                End If
            Next
            .Name = c
            Set rng = .Range("e13", .Cells(13, Cells.Columns.Count).End(xlToLeft))

            For i = rng.Columns.Count To 1 Step -1
                If rng(i) <> c Then
                    str = rng(i).Offset(-9).Address(0, 0, xlA1)
                    On Error Resume Next
                    .Shapes(str).Delete
                    On Error GoTo 0
                    rng(i).EntireColumn.Delete
                End If
            Next
        End With
    Next
    
    Worksheets("PLAYERSTATS").Activate
    FILLPLAYERSTATS
End Sub

1) Για να εμφανίζονται σωστά οι φωτογραφίες κάθε μία στο φύλλο EVALUATION θα πρέπει να περιέχεται πλήρως μέσα στο αντίστοιχο κελί.

2) Για το φύλλο PLAYERSTATS πιθανόν να χρειαστεί κάποια τροποποίηση της μακροεντολής FILLPLAYERSTATS.

[comsup]

Ευχαριστω, εφαρμοσα τον κωδικα και οι φωτογραφιες μεταφερονται σωστα. Εφοσον βεβαια βρισκονται εντος των κελιων οπως μου ειπες. Το αποτελεσμα ειναι 100% οπως το ηθελα.
Προσπαθησα με παραδειγμα τον κωδικα να καταλαβω πως γινεται η εντιγραφη των φωτογραφιων αλλα δεν καταφερα να εντοπισω την ακριβη συνταξη των εντολων. Για το ιδιο πραγμα, την αντιγραφη των φωτογραφιων του ροστερ στα φυλλα EVALUATION2, EVALUATION3, EVALUATION εχω εφαρμοσει εναν ακρως κομπογιαννιτικο τροπο. Εχω καταγραψει μια μακροεντολη που κανει ακριβως αυτες τις ενεργειες (αντιγραφη-επικολληση). Κατα την εκτελεση το αποτελεσμα μπορει να ειναι πρακτικα καλο, αλλα δεν ειμαι καθολου ευχαριστημενος απο το σχεδιασμο μου. Θα μπορουσες να μου δωσεις τη λυση σε αυτο ωστε να καταλαβω πως δουλευει; Καταλαβαινω τη λογικη του βρογχου, αλλα δεν μπορω να εντοπισω πως κανεις τις επιλογες των συντεταγμενων πηγης κ προορισμου.
Επισης - και ισως υπερβολικο να θελω να το ενταξω στο αρχειο - θα ηθελα να εμφανιζονται οι αντιστοιχες φωτογραφιες στο φυλλο PLAYERSTATS μετα απο την επιλογη απο τη λιστα στο κελι Α3.
Και μια που πηρα φορα, ενα αλλο φιλοδοξο σχεδιο που παρατησα λογω ανικανοτητας μου, ειναι να μπορω να εμφανιζω γραφημα αραχνης με τις ικανοτητες καθε παικτη αναλογα με τις επιλογες μου στη στηλη C.

[kapetang]

Καλημέρα

Στο συνημμένο βιβλίο έχω προσθέσει κάποιες χρήσιμες μακροεντολές

1) Οι POSITIONS και POSITIONSsimple αντιγράφουν πιστά (μαζί με τα σχήματα) ένα φύλλο και στο αντίγραφο αφαιρούν τα μη επιθυμητά στοιχεία (Σχήματα και στήλες).

Η POSITIONS αφαιρεί ρητά τα σχήματα.

Η POSITIONSsimple είναι απλούστερη και δεν ασχολείται με τη διαγραφή των σχημάτων.

Τα σχήματα διαγράφονται μαζί με τις στήλες που τα περιέχουν, επειδή φροντίσαμε, στην προέλευση, να έχουν την ιδιότητα move and size with cells (επισυνάπτεται σχήμα).

2) Οι CopyShape και CopyShape2 αντιγράφουν σχήματα από ένα φύλλο σε ένα άλλο.

Διαφέρουν στον τρόπο που καθορίζεται η θέση των αντιγράφων.

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

Κάνε δοκιμές να δεις πως δουλεύουν και πως θα μπορούσες να τις προσαρμόσεις σ’ αυτό που κάνεις.

[comsup]

Ευχαριστω πολυ, ενσωματωσα τις εντολες και η διαδικασια απλοποιηθηκε παρα πολύ. Επισης εκανε τρομερα ευκολο το να επαναλαβω σε οσα φυλλα χρειαζομαι την ιδια διαδικασια της αντιγραφης φωτογραφιων.
Το θεμα που δεν καταφερα να λυσω μελετωντας τους κωδικες ηταν το εξης: Υπαρχει το φυλλο MATCH SQUAD το οποιο εχει σκοπο να εκτυπωνει μια λιοστα με τους παικτες της τρεχουσας αποστολης αγωνα. Στις στηλες X - AC εμφανιζονται οι παικτες αναλογα με τη θεση τους στο γηπεδο κ κατοπιν με τη σειρα που εμφανιζονται στην λιστα EVALUATION. Θα ηθελα να εμφανιζεται η φωτογραφια του καθε παικτη στο αντιστοιχο κελι του πινακα X6 : AC29.
Μεχρι στιγμης αφου επιλεξω τους παικτες πληκτρολογωντας στα κελια που δεχονται τους αριθμους (πχ C6, C7 για τερματοφυλακες) μεχρι κ τους επιθετικους, πιανω με το ποντικι κ συρω τις φωτο των παικτων που επελεξα για να δημιουργησω μια εικονα με ολους τους παικτες μαζι. Δεν ξερω καν αν υπαρχει η δυνατοτητα να γινονται αυτα αυτοματοποιημενα. Φυσικα θα μπορουσα να αλλαξω τα παντα στο συγκεκριμενο φυλλο, αρκει να μπορω να εκτυπωσω μια σελιδα με ιδια εμφανιση ή παρομοια οπως στην φωτο που ανεβασα.