Ανανέωση ιστοσελίδας

[Flashgordon61]

Παρακαλώ την βοήθειά σας

Συμπληρώνω καθημερινά έναν πίνακα 12 στηλών & 18 γραμμών.(Συνολική Λίστα)
Επειδή κάποιες γραμμές επαναλαμβάνονται εκτός από τα δεδομένα στο τελευταίο κελί στη τελευταία στήλη (Μ)
Το ζητούμενο είναι ένας κώδικας VBA που να αντιγράφει την τελευταία γραμμή που έχει δεδομένα και να την επικολλά στην πρώτη κενή του πίνακα προτρέποντάς μας να αλάξουμε μόνο τα δεδομένα στο τελευταίο κελί στην τελευταία στήλη (Μ).

Σας ευχαριστώ εκ των προτέρων.

Γιώργος

[gr8styl]

Φίλε Γιώργο,
δεν είμαι σίγουρος σίγουρος για το ζητούμενο
Ο παρακάτω κώδικας εντοπίζει με βάσει την στήλη Β (B1:B18) την τελευταία γραμμή (LastRow) στον πίνακα B:L και την αντιγράφει στην επόμενη γραμμή που είναι κενή.
Δηλαδή για το παράδειγμα που μας έδωσες αντιγράφει το B3:L3 στο B4:L4 και τελειώνει με ενεργό το κελί M4.

Sub CopyLastRow()
Dim LastRow As Double
    LastRow = WorksheetFunction.CountA(Range("B1:B18"))
    Range("B" & LastRow & ":L" & LastRow).Copy Destination:= _
    Range("B" & LastRow + 1 & ":L" & LastRow + 1)
    Range("M" & LastRow + 1).Select
End Sub

Διευκρίνισε μας παραπέρα αν δεν ήταν αυτό το ζητούμενο.
Θανάσης

[Flashgordon61]

Φίλε Θανάση σ΄ευχαριστώ πολύ.
Ακριβώς αυτό ήθελα.

Γιώργος

[Flashgordon61]

Φίλε Θανάση βιάστηκα να πώ ότι είναι ακριβώς αυτό που ζητούσα.

Επανέρχομαι ζητώντας την βοήθειά σου διότι νόμιζα πως θα μπορούσα εύκολα να προσαρμόσω τον κώδικα στο πραγματικό αρχείο(Φόρμα). Όμως οι ελιπείς έως ανύπαρκτες γνώσεις μου στην VBA δεν μου επέτρεψαν να τα καταφέρω.
Στο πραγματικό αρχείο (Φόρμα) τα δεδομένα καταχωρούνται στην περιοχή {(Β11:M28) κίτρινη σκίαση} , τα υπόλοιπα κελιά είναι κλειδωμένα.
Το ζητούμενο είναι ο κώδικας VBA να αντιγράφει την τελευταία γραμμή του πίνακα (Περιοχή B11:M28) που έχει δεδομένα και να την επικολλά στην πρώτη κενή του πίνακα προτρέποντάς μας να αλάξουμε μόνο τα δεδομένα στην τελευταία στήλη (Μ)

Σ΄ευχαριστώ πολύ για την ανοχή σου

Γιώργος

[nisgia]

Γιώργο καλησπέρα!

Σου επιστρέφω το Total_List1.xls με τη λειτουργικότητα που αναζητάς η οποία βασίζεται στη διαδικασία (μακροεντολή) "OffsetLastLine"
της λειτουργικής μονάδας "Module1" που θα δεις αν πατήσεις Alt+F11έχοντας ανοιχτό το Total_List1.xls.
(θα πρέπει να ενεργοποιήσεις τις μακροεντολές κατά το άνοιγμά του)

Αυτή τη στιγμή μπορείς να την καλέσεις είτε από το παράθυρο διαλόγου "Μακροεντολές" ("Macros")
είτε πατώντας Ctrl+Shift+L (με πληκτρολόγιο στα Αγγλικά) αλλά μπορείς και να την αντιστοιχίσεις
σε κάποιο κουμπί ή σε κάποια εντολή αναδυόμενου μενού (δεξί κλικ).

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

Για ό,τι άλλο χρειαστείς, εδώ είμαστε.
Φιλικά, Γιάννης.

[Flashgordon61]

Φίλε Γιάννη σ΄ευχαριστώ πολύ για την λύση που μου έδωσες.
Πάνω απ΄όλα σ΄ευχαριστώ για την αναλυτικότητα με την οποία έγραψες τον κώδικα (Βοηθάει να κατανοήσω την διαδικασία, αρχάριος γαρ στην VBA).
Εγώ μπακαλίστικα σκεφτόμενος επειδή ήμουν και τυχερός (Στο πραγματικό αρχείο, Περιοχή Β1:Β9 , Πορτοκαλί σκίαση, δεν υπήρχαν δεδομένα),
ξεκλείδωσα την συγκεκριμένη περιοχή και τροποποίησα τον κώδικα που μου έδωσε ο φίλος ο Θανάσης (gr8styl) και έδωσα λύση στο πρόβλημά μου.
Η λύση σου όμως είναι η απόλυτη λύση.
Στο επισυναπτόμενο αρχείο έχω βάλει 2 Button και τα έχω αντιστοιχίσει με τις 2 λύσεις.
(Δέστο και πες μου πόσο μπακάλης μπορεί να είμαι)

Σας ευχαριστώ όλους
Ο φίλος σας
Γιώργος

[Tasos]

Καλημέρα σε όλους!
Γιώργο. δες ακόμα έναν τρόπο αντιγραφής της τελευταίας γραμμής με δεδομένα στην πρώτη κενή γραμμή της περιοχής "Table" του αρχείου σου:

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

Φιλικά / Τάσος

Sub CopyLastRow()

    Dim FirstFreeLine As Range, LastLine As Range

    With Range("Table")

        If Trim(.Cells(1)) <> vbNullString Then

            Set FirstFreeLine = .Cells(1).Offset(-1).End(xlDown).Offset(1).Resize(1, .Columns.Count)

        Else

            Set FirstFreeLine = .Cells(1).Resize(1, .Columns.Count)

        End If

        Set LastLine = .Offset(.Rows.Count + 1).End(xlUp).Resize(1, .Columns.Count)

        If FirstFreeLine.Row < LastLine.Row Then FirstFreeLine.Value = LastLine.Value

        'LastLine.ClearContents ' Διαγραφει την τελευταία γραμμή

        FirstFreeLine.Resize(1, 1).Offset(, .Columns.Count - 1).Select

        'SendKeys "{F2}" ' φέρνει το κελί σε κατάσταση επεξεργασίας

    End With

End Sub
        

[Flashgordon61]

Φίλε Τάσο σ΄ευχαριστώ κι εσένα για την τρίτη λύση στο πρόβλημα.
Πολύ καλή λύση με ένα μικρό λάθος.(μάλον λόγω της ώρας σύνταξης του κώδικα 03:43)

To If FirstFreeLine.Row < LastLine.Row Then FirstFreeLine.Value = LastLine.Value
πρέπει να γίνει If FirstFreeLine.Row > LastLine.Row Then FirstFreeLine.Value = LastLine.Value
Σ ευχαριστώ πολύ
Διατελώ μεθ΄υπολήψεως
Ο ελάχιστος
Γιώργος

[Tasos]

Γιώργο καλημέρα!
Γράφεις:

Το ζητούμενο είναι ένας κώδικας VBA που να αντιγράφει την τελευταία γραμμή που έχει δεδομένα και να την επικολλά στην πρώτη κενή του πίνακα προτρέποντάς μας να αλάξουμε μόνο τα δεδομένα στο τελευταίο κελί στην τελευταία στήλη (Μ).

Έτσι έχουμε:
τελευταία γραμμή που έχει δεδομένα = LastLine
πρώτη κενή του πίνακα = FirstFreeLine

Στον κώδικα έχουμε:

If FirstFreeLine.Row < LastLine.Row Then FirstFreeLine.Value = LastLine.Value

που σημαίνει ότι ΜΟΝΟ αν η πρώτη ελεύθερη γραμμή της περιοχής (FirstFreeLine.Row) είναι πάνω από την τελευταία γραμμή (LastLine) θα αντιγραφούν τα δεδομένα.

Αν πχ. η FirstFreeLine βρίσκεται στην γραμμή 12 και η LastLine επίσης στη γραμμή 12, ο κώδικας δεν θα κάνει την αντιγραφή γιατί θα διαγράψει τα ήδη υπάρχοντα δεδομένα της FirstFreeLine.

Με τον τρόπο που μου το περιγράφεις, δεν θα γίνει ποτέ αντιγραφή αφού ηFirstFreeLine
δεν θα μπορεί να είναι μεγαλύτερη της LastLine!

Ελπίζω να έγινα κατανοητός

Φιλικά

Τάσος

[Flashgordon61]

Φίλε Τάσο καλησπέρα
Η εντολή LastLine.ClearContents & η εντολή SendKeys "{F2}" όπως τις έγραψες δεν είναι ενεργοποιημένες

'LastLine.ClearContents ' Διαγραφει την τελευταία γραμμή
FirstFreeLine.Resize(1, 1).Offset(, .Columns.Count - 1).Select
'SendKeys "{F2}" ' φέρνει το κελί σε κατάσταση επεξεργασίας

Στο επισυναπτόμενο αρχείο, τον κώδικα που έδωσες (όπως ακριβως τον έγραψες) τον αντέγραψα σε ένα νέο module (motule3)
και τον αντιστοίχισα με το Button {Η λύση του (Τάσου) όπως τροποποιήθηκε} κάνοντας την αλλαγή που ανέφερα σε προγενέστερο μύνημα.

(To If FirstFreeLine.Row < LastLine.Row Then FirstFreeLine.Value = LastLine.Value
πρέπει να γίνει If FirstFreeLine.Row > LastLine.Row Then FirstFreeLine.Value = LastLine.Value)

Αν οι εγραφές στον πίνακα (Table) είναι συνεχείς (δεν υπάρχει κενή γραμμή και μετά γραμμή με δεδομένα) ο τροποποιημένος κώδικας
δουλεύει απόλυτα. εκτός από το γεγονός ότι επικολά και το τελευταίο κελί στην στήλη (Μ).
Άν υπάρχει κενή γραμμή και μετά γραμμή με δεδομένα, έχεις δίκιο ο κώδικας δουλεύει όπως ακριβώς τον έγραψες
(If FirstFreeLine.Row < LastLine.Row Then FirstFreeLine.Value = LastLine.Value).
Ίσως στο ζητούμενο έπρεπε να γράψω ότι οι εγραφές είναι συνεχείς.
Τέλος η πρόθεσή μου δεν ήταν να σε διορθώσω (πως θα μπορούσα άλωστε, έχω δηλώσει και σε προηγούμενα μυνήματα αρχάριος στη VBA),
απλώς κρίνοντας από το αποτέλεσμα με τον τροποποιημένο κώδικα έγραψα το παραπάνω μύνημα.

Φιλικά Γιώργος