Βοήθεια Excel για αντιγραφή κελιών με προυποθέσεις

[MastroGiannis]

8 ώρες πριν, papmel είπε

Perfect 

Εγω λεω λοιπον τωρα μιας και παιζουμε μπαλιτσα με το Excel να κανουμε κατι πιο πρωτοτυπο.

Ζητειτε excel λοιπον που να κανει τα εξης.

Να γραφεις ενα τιτλο ταινιας
και με ενα Click να σου πεταει τα αποτελέσματα και τα MP4 λινκ για να τα δεις Direct στο VLC.

Μου ηρθε εχθες η ιδεα

και πιο αργα θα το φτιάξω οποτε ας δουμε και εδω ιδεες πανω σε αυτο οποιος εχει χρονο και διαθεση.

Εντάξει, αντιλαμβάνομαι τον ενθουσιασμό σου αλλά, είπαμε να διατηρηθούμε ζεστοί με την προσπάθεια, όχι να καούμε με το Excel!... Άλλωστε, καλό είναι να μην ξεφεύγουμε απ’ το θέμα, κι όποιος θέλει, μπορεί να επιμείνει στη βελτιστοποίηση της κάθε προσέγγισης.  Όπως, για παράδειγμα, η εξάλειψη του δεύτερου βρόχου του κώδικα που παρέθεσα, η οποία δίνει στη μέθοδο MakeTable() την παρακάτω μορφή:

Private Sub MakeTable()
    Dim i As Long
    Dim r As Long
    Dim c As Integer
    Dim strKey As String
    Dim col As Collection

    'Ανάθεση τιμών στις μεταβλητές...
    Set col = New Collection                            'Δημιουργία βοηθητικής συλλογής.
    r = Range("b" & Rows.Count).End(xlUp).Row           'Εύρεση τελευταίας σειράς σε χρήση στη στήλη B.
    c = 4                                               'Αρχή πίνακα στη στήλη D.
    'Δημιουργία κεφαλίδας πίνακα...
    For i = 2 To r
        On Error Resume Next
        strKey = Range("b" & i).Text                    'Τρέχον όνομα μηνός.
        col.Add c, strKey                               'Προσπάθεια προσθήκης στη συλλογή.
        If Err = 0 Then                                 'Προστέθηκε με επιτυχία.
            Cells(1, c) = strKey                        'Προσθήκη νέας στήλης πίνακα.
            c = c + 1                                   'Αύξηση δείκτη θέσης
        End If
        'Προσθήκη τιμών στον πίνακα...
        Cells(i, 4).Resize(, col.Count).ClearContents   'Διαγραφή τυχών περιεχομένων γραμμής πίνακα.
        Cells(i, col(Cells(i, 2))) = Cells(i, 1)        'Προσθήκη τιμής στο αντίστοιχο κελί πίνακα.
    Next i
    Set col = Nothing                                   'Καταστροφή στιγμιότυπου Collection.
End Sub

Καλή συνέχεια!

[papmel]

Οκ ας κανω και εγω τοτε μια βελτισοποιηση στον δικο μου μιας και εγινε πολυ βιαστικα μεσα σε 3 λεπτα.
εν αναμονη.
 

και εδω αυτο που ειπα ηταν λιγο challenge αυτο δεν ηταν και τοσο ευκολο οσο νομιζα.
εχουν πολλα Protection οι ατιμοι.

http://94.130.91.150/temies.mp4

 

Sub Button1_Click()

Dim last_row As Integer
last_row = Cells(Rows.count, 1).End(xlUp).Row
Const startcol = 4
Dim dictposition
Set dictposition = CreateObject("Scripting.Dictionary")
Dim x As Integer
Dim minasposition()
'Dim count: count = 0


Dim mians As String
Dim count
count = 0
For x = 2 To last_row
Range("C" & x & ":P" & x).Clear    'Καθαριζουμε τα κελια απο 2 εως +12 μηνες
minas = Cells(x, 2)                'βαζουμε στην μεταβλητη minas το value του Cell για Speed
If minas <> "" Then                'ελεγχος αν εχει περιεχομενα το κελλι 2 με τον μηνα αν δεν εχει το αγνοω.

If Not dictposition.Exists(minas) Then 'Άν δεν υπαρχει ο μηνας τον βαζω στο dictionary
' το dictionary ειναι πιο γρηγορο και πρεπει να προτιματε https://stackoverflow.com/questions/32479842/comparison-of-dictionary-collections-and-arrays
'
dictposition.Add minas, count
Cells(1, startcol + count) = Cells(x, 2) ' δειχνω τον μηνα στην πρωτη σειρα.
count = count + 1                        'αυξανω μετρητη για τον επομενο μηνα
End If

Cells(x, startcol + dictposition(minas)) = Cells(x, 1)      'δειχνω το προιον βαση του μηνα στην θεση που ήδη εχω δεσμευσει.
End If
Next

Set dictposition = Nothing 'καθαριζουμε το dictionary
End Sub

οσο πιο μαζεμενο γινετε.
 

Επεξ/σία 18 Δεκεμβρίου 2020 από papmel

[MastroGiannis]

5 ώρες πριν, papmel είπε

οσο πιο μαζεμενο γινετε.

Εύγε νέε μου! :-)

Μερικές παρατηρήσεις:

1. Από το Excel 2007 και μετά, τα φύλλα του διαθέτουν 1.048.576 γραμμές (rows). Πολλές περισσότερες από τη χωρητικότητα μιας μεταβλητής Integer. Συνεπώς, η last_row θα έπρεπε να είναι τύπου Long. Το ίδιο ισχύει και για τη μεταβλητή x.
2. Ο πίνακας minasposition() δηλώνεται αλλά δε χρησιμοποιείται.
3. Δηλώνεται η mians αλλά χρησιμοποιείται η minas η οποία δεν έχει δηλωθεί. Θα πρέπει πάντα στην κορυφή κάθε μονάδας κώδικα να υπάρχει η δήλωση Option Explicit.
4. Δηλώνεις (χωρίς τύπο δεδομένων) Const startcol = 4 αλλά καθαρίζεις την περιοχή “Cx:Px” η οποία περιλαμβάνει 14 κελιά. Επίσης, η Clear εξαλείφει τα πάντα από μια περιοχή κελιών, και όχι μόνο τα περιεχόμενά της. Καλύτερα να χρησιμοποιείται η ClearContents.
5. Υποστηρίζεις πως "το dictionary ειναι πιο γρηγορο". Δεν ξέρω αν σ’ αυτή την περιορισμένη χρήση του πόσο γρηγορότερο είναι από τo Collection (θα πρέπει να κάνουμε μετρήσεις) αλλά, η late binding επιβαρύνει τη διαδικασία με έλεγχο τύπων κατά το χρόνο εκτέλεσης.

Καλή συνέχεια!

[papmel]

7 ώρες πριν, MastroGiannis είπε

Εύγε νέε μου!

Μερικές παρατηρήσεις:

1. Από το Excel 2007 και μετά, τα φύλλα του διαθέτουν 1.048.576 γραμμές (rows). Πολλές περισσότερες από τη χωρητικότητα μιας μεταβλητής Integer. Συνεπώς, η last_row θα έπρεπε να είναι τύπου Long. Το ίδιο ισχύει και για τη μεταβλητή x.
2. Ο πίνακας minasposition() δηλώνεται αλλά δε χρησιμοποιείται.
3. Δηλώνεται η mians αλλά χρησιμοποιείται η minas η οποία δεν έχει δηλωθεί. Θα πρέπει πάντα στην κορυφή κάθε μονάδας κώδικα να υπάρχει η δήλωση Option Explicit.
4. Δηλώνεις (χωρίς τύπο δεδομένων) Const startcol = 4 αλλά καθαρίζεις την περιοχή “Cx:Px” η οποία περιλαμβάνει 14 κελιά. Επίσης, η Clear εξαλείφει τα πάντα από μια περιοχή κελιών, και όχι μόνο τα περιεχόμενά της. Καλύτερα να χρησιμοποιείται η ClearContents.
5. Υποστηρίζεις πως "το dictionary ειναι πιο γρηγορο". Δεν ξέρω αν σ’ αυτή την περιορισμένη χρήση του πόσο γρηγορότερο είναι από τo Collection (θα πρέπει να κάνουμε μετρήσεις) αλλά, η late binding επιβαρύνει τη διαδικασία με έλεγχο τύπων κατά το χρόνο εκτέλεσης.

Καλή συνέχεια!

ναι οταν γραφεις μεσα στο excel και οχι σε ενα notepad γινοντεκαι αυτα.

1) το minasposition()  ειναι απλα ξεχασμενο απο τον προηγουμενο κωδικα 
2) το Option explicit μπανει παντα αλλα εδω τι να βαλεις σε 10 εντολες
3)Το Optimization ειναι ακριβως στην περιοχη CXPX Αφου ξερεις οτι εχεις MAX 12 μηνες δεν χρειαζεται να τα καθαριζεις ολα.
+1 Για το Clear Contents

Ti Συνεχεια και πολυ ασχοληθηκα  με αυτο.
απλα εδωσα την απαντηση επειδη ζητησες optim code..