Excel - Ερωτήσεις / Απαντήσεις Ότι έχει σχέση με συναρτήσεις, μορφοποίηση, εκτυπώσεις γραφήματα κτλ. |
| Εργαλεία Θεμάτων | Τρόποι εμφάνισης |
#1
| |||
| |||
Μεταφρά δεδομένων σε πίνακες Excel
Καλησπέρα σας. Αυτήν την φορά ψάχνω να βρώ κάτι πάρα πολύ δύσκολο για μένα. Έχω βρεί αρκετά παραδείγματα μέσα στο φόρουμ, άλλα απέτυχα να τα εφαρμόσω, απέχουν πολυ από τις δυνατότητες ενός αρχάριου όπως εγώ. Εχω 2 πίνακες στο 1ο φύλλο, θα ήθελα να μεταφέρονται τα δεδομένα με κουμπί σε 2 άλλους πίνακες, που βρίσκονται,, ο πρώτος πίνακας στο 2ο φύλλο και ο δεύτερος πίνακας στο 3ο φύλλο. Στην συνέχεια να διαγράφονται τα δεδομένα απο του 2 πίνακες του πρώτου φύλλου. Όταν επαναληφθεί τα νέα δεδομένα θα πρέπει να μεταφερθούν κάτω απο τα παλία δεδομένα. Εχω γράψει πληροφορίες στο συνημμένο. Ευχαριστώ εκ των προτέρων. Τελευταία επεξεργασία από το χρήστη gr8styl : 10-03-12 στις 07:20. Αιτία: Add prefix |
#2
|
Καλημέρα φίλε Μάνο. αντέγραψε τον παρακάτω κώδικα σε ένα 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 |
#3
| |||
| |||
Καλημέρα φίλε Θανάση. Υπερευχαριστώ για την βοήθεια. Έφτιαξα τον παραπάνω κώδικα με μια μικρή αλλαγή. Ένωσα τις εντολές σε μία, επίσης πρόσθεσα απο άλλον κώδικα που βρήκα εδώ, το (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 Βρήκα πως φτιάχνετε και το κουμπί !! Ευχαριστώ πολύ Τελευταία επεξεργασία από το χρήστη manos1 : 10-03-12 στις 11:45. |
#4
| |||
| |||
Γειά αν και είδα ότι δόθηκε η λύση, ανεβάζω, μια που το δούλεψα, με μεταφορά μια- μια εγγραφή Θανάσης
|
#5
| ||||
| ||||
Καλημέρα σε όλους! Φίλε Μάνο Συγχαρητήρια! Αν και αρχάριος, τα πας πολύ καλά με την 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. Ούτε χρειάζεται να επιλέξεις το φύλλο που περιέχει έναν πίνακα για να κάνεις κάποια εργασία πάνω σ αυτόν προγραμματιστικά. Επισυνάπτω ένα παράδειγμα που υλοποιεί τα αναγραφόμενα. Στο παράδειγμα αυτό έχω αλλάξει τα ονόματα ορισμένων πινάκων για να είναι ο κώδικας πιο κατανοητός. Ελπίζω να μην σας κούρασα! Φιλικά Τάσος
__________________ Ms-Office Development Team Ανάπτυξη επαγγελματικών εφαρμογών Τελευταία επεξεργασία από το χρήστη Tasos : 13-03-12 στις 08:58. Αιτία: Τροποποίηση στον κώδικα VBA (αντιγραφή φιλτραρισμένου πίνακα) |
#6
| |||
| |||
Καλησπέρα καλή εβδομάδα Ευχαριστώ για τις χρήσιμες προτάσεις, είχα στο μυαλό μου μόνο περί ημερομηνιών και α/α, οτι μπορεί να γίνει μέσω VBA, πρίν γράψω το πρώτο πόστ (ενημερώθηκα απο κάποιο παλιότερο ποστ του φόρουμ), ρώτησα όμως τα απολύτως απαραίτητα για ευνόητους λόγους. Είναι αξιοσημείωτο ότι το συνημμένο με αυτές τις βελτιώσεις είναι πιο γρήγορο και περίπου 10 φορές μικρότερο! Επίσης είναι πολύ πιό πρακτικοί οι πίνακες αποθήκευσης. Το μόνο που πιστεύω οτι δεν είναι και τόσο πρακτικό, είναι τα 4 κουμπιά, μάλιστα όσα παραδείγματα έχω δει στο φόρουμ για 1 πίνακα έχουν 2 κουμπιά, 1 για μεταφορά και 1 για διαγραφή. Έχω την εντύπωση οτι 1 κουμπί για όλες τις ενέργειές θα ήταν πίο πρακτικό. Προσπάθησα να το φτιάξω για να τσεκάρω την λειτουργία του αλλά δεν τα κατάφερα αυτήν την φορά |
#7
| |||
| |||
Τάσο Ευχαριστώ για τον τρόπο αντιγραφής πινάκων, προσπάθησα να κάνω εφαρμογή του παραπάνω αρχείου, σε φιλτραρισμένο πίνακα, αλλά παρατήρησα ότι μεταφέρει το σύνολο των εγγραφών, μήπως θα ήταν δυνατό να περιλαμβάνει και την περίπτωση Φίλτρου. Για τον Μάνο η χρήση διαφορετικών κουμπιών είναι η πιο σωστή μέθοδος, γιατί ελέγχεις, αν έγινε σωστά η αντιγραφή, και μερικές φορές επαναλαμβάνονται οι ίδιες εγγραφές, στην περίπτωση που θες να γίνεται Αντιγραφή - Σβήσιμο, προσθέτεις πριν απο την End sub την εντολή που αντιστοιχεί στο κουμπί που σβήνει τον πίνακα (πατώντας πάνω στο κουμπί δεξί πλήκτρο αντιστοίχηση μακροεντολής επεξεργασία -κώδικας) Θανάσης Τελευταία επεξεργασία από το χρήστη Thanosp : 12-03-12 στις 17:09. |
#8
| ||||
| ||||
Καλησπέρα Θανάση! Για αντιγραφή μόνο φιλτραρισμένων εγγραφών δοκίμασε τον παρακάτω κώδικα στο παράδειγμα του προηγούμενου μηνύματος μου (αντικαθιστά τον παλιό "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 Φιλικά Τάσος
__________________ Ms-Office Development Team Ανάπτυξη επαγγελματικών εφαρμογών Τελευταία επεξεργασία από το χρήστη Tasos : 13-03-12 στις 08:56. |
#9
| |||
| |||
Καλημέρα Τάσο Ευχαριστώ πάρα πολύ νά είσαι πάντα καλά !!! |
Ετικέτες |
structured table, vba, δομημένοι πίνακες |
« Προηγούμενο Θέμα
|
Επόμενο Θέμα »
Εργαλεία Θεμάτων | |
Τρόποι εμφάνισης | |
| |
Παρόμοια Θέματα | ||||
Θέμα | Δημιουργός | Forum | Απαντήσεις | Τελευταίο Μήνυμα |
[Γενικά] ΠΙΝΑΚΕΣ ΔΕΔΟΜΕΝΩΝ ΚΑΙ ΑΝΤΛΗΣΗ ΣΤΟΙΧΕΙΩΝ | ΑΠΟΣΤΟΛΗΣΚ | Excel - Ερωτήσεις / Απαντήσεις | 5 | 06-11-16 21:11 |
[Γενικά] ΔΙΑΣΠΑΣΗ ΔΕΔΟΜΕΝΩΝ ΣΕ ΑΡΧΕΙΑ EXCEL | gaz_manos | Excel - Ερωτήσεις / Απαντήσεις | 5 | 21-01-15 15:32 |
[ Πίνακες ] Εισαγωγή δεδομένων από Excel | gaz_manos | Access - Ερωτήσεις / Απαντήσεις | 1 | 07-12-12 14:09 |
[ Φόρμες ] Καταχώριση δεδομένων σε δυο πίνακες | antonib | Access - Ερωτήσεις / Απαντήσεις | 10 | 14-10-12 10:30 |
Μεταφορά κελιών από καρτέλα Excel σε πίνακες της Access | germanos | Ms-Office | 12 | 07-06-09 10:06 |
Η ώρα είναι 06:07.