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

[manos1]

Καλησπέρα σας.
Αυτήν την φορά ψάχνω να βρώ κάτι πάρα πολύ δύσκολο για μένα. Έχω βρεί αρκετά παραδείγματα μέσα στο φόρουμ, άλλα απέτυχα να τα εφαρμόσω, απέχουν πολυ από τις δυνατότητες ενός αρχάριου όπως εγώ.
Εχω 2 πίνακες στο 1ο φύλλο, θα ήθελα να μεταφέρονται τα δεδομένα με κουμπί σε 2 άλλους πίνακες, που βρίσκονται,, ο πρώτος πίνακας στο 2ο φύλλο και ο δεύτερος πίνακας στο 3ο φύλλο. Στην συνέχεια να διαγράφονται τα δεδομένα απο του 2 πίνακες του πρώτου φύλλου. Όταν επαναληφθεί τα νέα δεδομένα θα πρέπει να μεταφερθούν κάτω απο τα παλία δεδομένα. Εχω γράψει πληροφορίες στο συνημμένο. Ευχαριστώ εκ των προτέρων.

[gr8styl]

Καλημέρα φίλε Μάνο.
αντέγραψε τον παρακάτω κώδικα σε ένα Module της VBA και φτιάξε δυο κουμπιά.
Το πρώτο θα καλεί την copy_to_dst() για αντιγραφή και επικόλληση τιμών, ενώ το δεύτερο θα καλεί την clear_src() για καθάρισμα των τιμών μόνον.

Πες μας αν έγινε.

Φιλικά
Θανάσης
ΥΓ. Προσοχή γιατί οι ημερομηνίες είναι τύποι, δηλαδή θα πρέπει να κάνεις αντιγραφή και επικόλληση τιμών ή να καταχωρείς την ημερομηνία μέσω VBA αν θέλεις να μην αλλάζουν κάθε φορά που υπολογίζεται το φύλλο.

Option Explicit

Sub copy_to_dst()
Dim Dst
    Dst = WorksheetFunction.Max(Sheets("ΠΩΛΗΣΕΙΣ").Range("A:A")) + 2
    Range("Πίνακας6").Copy
    Sheets("ΠΩΛΗΣΕΙΣ").Range("C" & Dst).PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    Dst = WorksheetFunction.Max(Sheets("ΕΠΙΣΚΕΨΕΙΣ").Range("A:A")) + 2
    Range("Πίνακας4").Copy
    Sheets("ΕΠΙΣΚΕΨΕΙΣ").Range("C" & Dst).PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

Sub clear_src()
    Range("Πίνακας6").SpecialCells(xlCellTypeConstants, 23).ClearContents
    Range("Πίνακας4").SpecialCells(xlCellTypeConstants, 23).ClearContents
End Sub

[manos1]

Καλημέρα φίλε Θανάση.
Υπερευχαριστώ για την βοήθεια. Έφτιαξα τον παραπάνω κώδικα με μια μικρή αλλαγή.

Ένωσα τις εντολές σε μία, επίσης πρόσθεσα απο άλλον κώδικα που βρήκα εδώ, το (MsgBox "Data saved.")........



Sub copy_to_dst()
Dim Dst
Dst = WorksheetFunction.Max(Sheets("ΠΩΛΗΣΕΙΣ").R ange("A:A")) + 2
Range("Πίνακας6").Copy
Sheets("ΠΩΛΗΣΕΙΣ").Range("C" & Dst).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Dst = WorksheetFunction.Max(Sheets("ΕΠΙΣΚΕΨΕΙΣ ").Range("A:A")) + 2
Range("Πίνακας4").Copy
Sheets("ΕΠΙΣΚΕΨΕΙΣ").Range("C" & Dst).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range("Πίνακας6").SpecialCells(xlCellTypeCo nstants, 23).ClearContents
Range("Πίνακας4").SpecialCells(xlCellTypeCo nstants, 23).ClearContents

MsgBox "Data saved."
End Sub


.....ελπίζω να είναι σωστές οι αλλαγές που έκανα,, λογικά είναι, γιατι δούλεψε μιά χαρά !!!


Οι ημερομηνίες δουλεύουν σωστά,, ακολούθησα τις παρακάτω οδηγίες...

http://www.ms-office.gr/forum/excel-...sto-excel.html

Βρήκα πως φτιάχνετε και το κουμπί !! Ευχαριστώ πολύ

[Thanosp]

Γειά αν και είδα ότι δόθηκε η λύση, ανεβάζω, μια που το δούλεψα, με μεταφορά μια- μια εγγραφή Θανάσης

[Tasos]

Καλημέρα σε όλους!

Φίλε Μάνο Συγχαρητήρια! Αν και αρχάριος, τα πας πολύ καλά με την VBA!

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

1. Ο Α/Α (που παίζει το ρόλο του μοναδικού αριθμού για κάθε εγγραφή) Θα πρέπει να είναι σταθερός αριθμός.
Δεν έχει νόημα ο Α/Α να προκύπτει από τύπο αφού σε μια ταξινόμηση του πίνακα δεν ακολουθεί τα δεδομένα όπως θα έπρεπε.
Εκτός αυτού, μετά από κενή γραμμή ξεκινά την αρίθμηση από το 1.

2. Η λύση με την ημερομηνία που χρησιμοποίησες είναι καλή. Συνιστάται για αρχεία που δεν περιέχουν VBA όμως.
Αφού εσύ ήδη χρησιμοποιείς VBA, θα ήταν πιο πρακτικό πιο αξιόπιστο και πιο αποδοτικό για την εφαρμογή
αν η ημερομηνία και o A/A καταχωρούνταν προγραμματιστικά και όχι με τύπους + ρυθμίσεις επαναληπτικού υπολογισμού.

3. Τα ονόματα Πίνακας1, Πίνακας2, Πίνακας3 κτλ. δε σε διευκολύνουν στον προγραμματισμό.
Είναι πιο απλό αντί για Πίνακας6 να χρησιμοποιείς GreenTable (ο πράσινος πίνακας που αναφέρεις στο συνημμένο σου).
Θα κερδίσεις πολλά αν αφιερώσεις 5 λεπτά για να τροποποιήσεις τα ονόματα του βιβλίου και να τους δώσεις νόημα για να τα βρίσκεις ευκολότερα.

4. Σε περιπτώσεις όπως τη δική σου όπου μεταφέρονται μόνο οι τιμές μιας περιοχής σε μια άλλη, η μέθοδος αντιγραφής – επικόλλησης με VBA δεν χρειάζεται.
Για παράδειγμα, η γραμμή Range(B1).Value = Range(A1).Value αρκεί (είναι και γρηγορότερη) για να μεταφερθούν τα δεδομένα του κελιού Α1 στο κελί Β1.

5. Το συνημμένο παράδειγμα του μηνύματος μου έχει μέγεθος κάτω από 50 KB
παρόλο που περιέχει περισσότερα στοιχεία από το αρχικό σου.

Πως γίνεται αυτό: Έχω διαγράψει τις περιοχές των φύλλων που δεν χρησιμοποιούνται καθώς και τις κενές γραμμές των πινάκων.
Έτσι όπως θα παρατηρήσει κανείς, το αρχείο ανοίγει και αποθηκεύεται πολύ πιο γρήγορα και δεν καταλαμβάνει άσκοπα πολύ χώρο στο σκληρό δίσκο.

6. Αν η ημερομηνία και o A/A καταχωρηθεί προγραμματιστικά θα χρειαστεί να μεταφέρεις μόνο τις γραμμές του πίνακα που περιέχουν δεδομένα

Αγαπητέ Θανάση (Thanosp), βρίσκω σωστή τη μέθοδο ListObject.ListRows.Add… που χρησιμοποιείς με τη διαφορά ότι είναι χαρακτηριστικά αργή αφού σε κάθε της
εκτέλεση ωθεί ολόκληρο το φύλλο (από τον πίνακα και κάτω) προς τα κάτω (κάνει Insert).

Αν χρησιμοποιήσεις ListObject.Resize (μια φορά για όλες τις νέες γραμμές που θα εισαχθούν) αντί για ListObject.ListRows.Add αυξάνεις κατά πολύ την
ταχύτητα εκτέλεσης.

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

Γενικά η χρήση του αντικειμένου Select στο 99,9% των περιπτώσεων μπορεί και πρέπει να αποφεύγεται.
Μπορείς να αναφερθείς σε ένα αντικείμενο ListObject γνωρίζοντας μόνο το όνομα του

Για παράδειγμα:
Η έκφραση Range("Πινακας3"). ListObject μας επιστρέφει το αντικείμενο ListObject με το όνομα Πινακας3.
Ούτε χρειάζεται να επιλέξεις το φύλλο που περιέχει έναν πίνακα για να κάνεις κάποια εργασία πάνω σ αυτόν προγραμματιστικά.

Επισυνάπτω ένα παράδειγμα που υλοποιεί τα αναγραφόμενα.

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

Ελπίζω να μην σας κούρασα!

Φιλικά

Τάσος

[manos1]

Καλησπέρα καλή εβδομάδα

Ευχαριστώ για τις χρήσιμες προτάσεις, είχα στο μυαλό μου μόνο περί ημερομηνιών και α/α, οτι μπορεί να γίνει μέσω VBA, πρίν γράψω το πρώτο πόστ (ενημερώθηκα απο κάποιο παλιότερο ποστ του φόρουμ), ρώτησα όμως τα απολύτως απαραίτητα για ευνόητους λόγους.
Είναι αξιοσημείωτο ότι το συνημμένο με αυτές τις βελτιώσεις είναι πιο γρήγορο και περίπου 10 φορές μικρότερο! Επίσης είναι πολύ πιό πρακτικοί οι πίνακες αποθήκευσης.
Το μόνο που πιστεύω οτι δεν είναι και τόσο πρακτικό, είναι τα 4 κουμπιά, μάλιστα όσα παραδείγματα έχω δει στο φόρουμ για 1 πίνακα έχουν 2 κουμπιά, 1 για μεταφορά και 1 για διαγραφή. Έχω την εντύπωση οτι 1 κουμπί για όλες τις ενέργειές θα ήταν πίο πρακτικό. Προσπάθησα να το φτιάξω για να τσεκάρω την λειτουργία του αλλά δεν τα κατάφερα αυτήν την φορά

[Thanosp]

Τάσο
Ευχαριστώ για τον τρόπο αντιγραφής πινάκων, προσπάθησα να κάνω εφαρμογή του παραπάνω αρχείου, σε φιλτραρισμένο πίνακα, αλλά παρατήρησα ότι μεταφέρει το σύνολο των εγγραφών, μήπως θα ήταν δυνατό να περιλαμβάνει και την περίπτωση Φίλτρου. Για τον Μάνο η χρήση διαφορετικών κουμπιών είναι η πιο σωστή μέθοδος, γιατί ελέγχεις, αν έγινε σωστά η αντιγραφή, και μερικές φορές επαναλαμβάνονται οι ίδιες εγγραφές, στην περίπτωση που θες να γίνεται Αντιγραφή - Σβήσιμο, προσθέτεις πριν απο την End sub την εντολή που αντιστοιχεί στο κουμπί που σβήνει τον πίνακα (πατώντας πάνω στο κουμπί δεξί πλήκτρο αντιστοίχηση μακροεντολής επεξεργασία -κώδικας)
Θανάσης

[Tasos]

Καλησπέρα Θανάση!

Για αντιγραφή μόνο φιλτραρισμένων εγγραφών δοκίμασε τον παρακάτω κώδικα στο παράδειγμα του προηγούμενου μηνύματος μου (αντικαθιστά τον παλιό "CopyToTable"):

Sub CopyToTable(ByVal SourceList As ListObject, _
                ByVal TargetList As ListObject, _
                ByVal rng As Range, _
                ByVal rng1 As Range)
    Dim i As Long, t As Long, s As Long, x As Long, c As Long, lstRow As ListRow

    If IsEmpty(rng.Cells(1)) Then Exit Sub

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    c = SourceList.ListColumns.Count
    s = WorksheetFunction.Subtotal(3, rng)
    With TargetList
        t = .ListRows.Count + 1
        .Resize .Range.Resize(t + s, .ListColumns.Count)
        i = t
        For Each lstRow In SourceList.ListRows
            If Not lstRow.Range.EntireRow.Hidden Then
                TargetList.ListRows(i).Range(1, 1).Value = Application.Max(rng1) + 1
                TargetList.ListRows(i).Range(1, 2).Value = Now
                TargetList.ListRows(i).Range.Offset(, 2).Resize(1, c).Value = lstRow.Range.Value
                i = i + 1
            End If

        Next
    End With
    Application.Calculation = xlCalculationAutomatic
    If t + s - 1 > 0 Then MsgBox "Εγινε!", vbInformation, "ms-office.gr"
End Sub

Αν θέλεις να τρέχεις όλες τις μακροεντολές τη μια μετά την άλλη για να αντιγράψεις εγγραφές και έπειτα να τις διαγράψεις από την πηγή μπορείς να χρησιμοποιήσεις:

Sub CopyAllAndClear()
    CopyGreenTable
    copyYellowTable
    ClearGreenTable
    ClearYellowTable
End Sub

Διόρθωσα τον κώδικα και στο συνημμένο του προηγούμενου μηνύματος μου.

Φιλικά

Τάσος

[Thanosp]

Καλημέρα Τάσο
Ευχαριστώ πάρα πολύ νά είσαι πάντα καλά !!!