Forum - Excel07 Αυτόματη συμπλήρωση από πολλές λίστες σε μία.

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [Excel07] Αυτόματη συμπλήρωση από πολλές λίστες σε μία. (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/3946-aytomati-symplirosi-apo-polles-listes-se-mia.html)

stam75

05-12-15 11:29

Αυτόματη συμπλήρωση από πολλές λίστες σε μία.

1 Συνημμένο(α)

Καλημέρα, μπορεί κάποιος να με βοηθήσει παρακαλώ;
στο φύλλο "Πρώτο" έχω μια περιοχή D5:AG5 στην οποία είναι οι τίτλοι των 30 στηλών.

στην περιοχή D6:AG35 έχω αριθμούς σε διάφορα κελιά, πχ. σε κάποιες στήλες έχει 10 κελιά κατηλλειμένα, σε κάποιες έχει 30 κελιά κατηλλειμένα, σε κάποιες 19 κελιά κατηλλειμένα.

Θέλω στο φύλλο "Σύνολο" και στο κελί E5 και κάτω, να εμφανίζει όλα
τα δεδομένα από τις στήλες της περιοχής D6:AG35 και στο κελί C5 και κάτω τον τίτλο της κάθε στήλης.

Κάθε στήλη μπορεί να έχει κατηλλειμένα από 0 έως και 30 κελιά με αριθμούς,
οπότε, εάν προσθέτω ή αφαιρώ αριθμούς από κάθε στήλη στην περιοχή D6:AG35, αυτόματα να εμφανίζονται
ή να διαγράφονται στα κελιά 5 και κάτω των στηλών E και C του φύλλου "Σύνολο" χωρίς κενές σειρές μεταξύ τους.
Με συγχωρείτε για τα κεφαλαία στο βιβλίο.
Ευχαριστώ πολύ για τον χρόνο σας.

kapetang

05-12-15 15:41

1 Συνημμένο(α)

Καλησπέρα

Σταμάτη, δες μια πρόταση στο συνημμένο.

Για τη λύση χρησιμοποιείται κώδικας, συνεπώς θα πρέπει να είναι ενεργοποιημένες οι μακροεντολές.

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

stam75

05-12-15 18:26

Καλησπέρα Γιώργο, σε ευχαριστώ πάρα πολύ για τη βοήθειά σου! Ενώ ανοίγω το βιβλίο σου, το δοκιμάζω και κάνει ακριβώς αυτό που ζητάω, όταν αντιγράφω τον κώδικα στο δικό μου και προσθέτω το commantbutton για κάποιο λόγο δε δουλεύει.. Τι κάνω λάθος;;

stam75

05-12-15 18:38

Μάλλον έχω κάνει εγώ λάθος.
Διόρθωση, οι αριθμοί που θα μεταφέρονται στο άλλο φύλλο θέλω να μεταφέρονται στο κελί F5 και κάτω, ενώ οι τίτλοι για τον κάθε άριθμό στο κελί D5 και κάτω, ανάλογα σε ποιον τίτλο είναι ο κάθε αριθμός.
Ευχαριστώ πολύ και πάλι Γιώργο.

kapetang

05-12-15 18:59

1 Συνημμένο(α)

Σταμάτη, δες το συνημμένο

stam75

05-12-15 19:16

Αντέγραψα τον κώδικα, λειτουργεί, μεταφέρει τα δεδομένα από τις στήλες στο άλλο φύλλο, όμως ενώ στο δικό σου το κάνει σωστά, στο δικό μου ξεκινάει η επικόλληση από το κελί F5 και αντιγράφει ότι έχει και δεν έχει η κάθε στήλη όλα στην στήλη F. Γίνεται να αντιγράφει στην στήλη F και στο κελί 5 και κάτω μόνο ότι περιέχει στα κελιά D6:D35 έως και AG5:AG35; και στη στήλη D και στο κελί 5 και κάτω τον ανάλογο τίτλο από την περιοχή D5:AG5;
Γιώργο συγνώμη που σε ταλαιπωρώ δεν τα πάω καθόλου καλά με τους κώδικες..

kapetang

05-12-15 20:07

Σταμάτη, δοκίμασε τον κώδικα:

Κώδικας:

Option Explicit
 

Private Sub cmdCopyColumns_Click()

    Dim rngIn As Range, rngTarget As Range

    Dim R As Long, C As Long, lngR As Long, K As Long
 

    'Εδώ ορίζεται η περιοχή των δεδομένων

    Set rngIn = Range("D5:AG40")

    

    'Εδώ ορίζεται η περιοχή όπου θα γίνει η αντιγραφή

    Set rngTarget = Worksheets("Σύνολο").Range("D5")

    

    rngTarget.CurrentRegion.Resize(, 3).Offset(1).ClearContents

    For C = 1 To rngIn.Columns.Count

        For R = 2 To rngIn.Rows.Count

            If Len(Replace(rngIn.Cells(R, C), " ", "")) > 0 Then

                rngTarget.Offset(K, 0) = rngIn(1, C)

                rngTarget.Offset(K, 2) = rngIn(R, C)

                K = K + 1

            End If

        Next

    Next

    MsgBox "Η αντιγραφή ολοκληρώθηκε"

End Sub

Μπορείς να αλλάξεις την περιοχή των δεδομένων, αλλάζοντας το μπλε τμήμα του κώδικα.

Η γραμμή 1, 2, 3, κλπ περιλαμβάνεται στην περιοχή δεδομένων

stam75

05-12-15 20:36

Γιώργο χίλια ευχαριστώ για το ενδιαφέρον σου και την βοήθεια που δίνεις, δεν μπορώ να το καταφέρω όμως. Κρίμα, γιατί είναι ότι ακριβώς χρειαζόμουν.
Σε ευχαριστώ και πάλι και συγνώμη για την ταλαιπωρία που προκάλεσα.

kapetang

05-12-15 21:03

Τελευταία προσπάθεια.

Για την αντιγραφή του κώδικα, ακολούθησε τα βήματα:

1) Πρόσθεσε στο φύλλο ένα CommandButton της ομάδας ActiveX.

2) Κάνε διπλό κλικ για να ανοίξει το παράθυρο του κώδικα.

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

Το αρχείο για να υποστηρίζει κώδικα, αποθηκεύεται σε μορφή xlsm

stam75

06-12-15 08:44

Καλημερα Γιωργο, κάνω αυτό ακριβώς που αναφερεις πιο πάνω αλλά για μια τελευταία προσπάθεια θα το επιχειρησω! Θα επανελθω με τα αποτελέσματα.

Δυστυχώς μια από τα ίδια...
Δεν πειράζει, να είσαι καλά Γιώργο.

Spirosgr

07-12-15 05:03

1 Συνημμένο(α)

Καλησπέρα
Σταμάτη,
υπάρχει περίπτωση, να έχεις «ξεχάσει» το κουμπί "Dising Mode" (*βλέπε εικόνα)
«αναμμένο» κι έτσι δεν λειτουργεί το active x.

Αν δεν είναι έτσι...τότε:
Στο φύλλο, άνοιξε το συμβάν του διπλού κλικ και
βάλε τον κώδικα μέσα εκεί, αφού συμπληρώσεις και τα πιο κάτω...

Κώδικας:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 '*εδώ τα dim

    If Intersect(Target, Sheet1.Range("d2")) Is Nothing Then Exit Sub
 '*εδώ ο κώδικας

    Cancel = True
 '*εδώ το μνμ από msgbox

End Sub

Διπλό κλικ στο D2 φύλλο Πρώτο, εξαπολύει το συμβάν...
**Μπορείς να επιλέξεις όποιο κελί θέλεις στην θέση του d2
Όπου Sheet1 το κωδικό όνομα του φύλλου...Για Ελληνικά Φύλλο1 ή όποιο άλλο φύλλο...

stam75

07-12-15 18:06

Καλησπέρα Σπύρο σε ευχαριστώ πολύ για το ενδιαφέρον και την πρόταση σου. Το κουμπί το απενεργοποιω δεν είναι από αυτό. Δεν πολυκαταλαβα τι εννοεις στον κωδικα που προσθεσες. Επισης να σημείωσω ένα λάθος μου το οποίο δεν ξέρω αν παίζει ρόλο. Οι στήλες που θέλω να πηγαινουν τα δεδομένα είναι ή E για τους τίτλους και ή F για τα δεδομένα της κάθε στήλης. Συγχωρέστε με γιαυτο..

kapetang

07-12-15 20:06

1 Συνημμένο(α)

Καλησπέρα

Σταμάτη, αφού αλλάζει η περιοχή στην οποία θα αντιγραφούν τα δεδομένα, θα πρέπει να αλλάξει και ο κώδικας.

Δες το συνημμένο.

Αφού αντιμετωπίζεις πρόβλημα στη μεταφορά του κώδικα, θα σου πρότεινα να αντιγράψεις τα δεδομένα σου στο φύλλο «Πρώτο» και κάτω από τις στήλες 1, 2, 3, …30 του συνημμένου.

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

stam75

07-12-15 20:53

Σε ευχαριστώ πολύ Γιώργο! θα το τεστάρω και θα ενημερώσω για την εξέλιξη. Να είσαι καλά και να με συγχωρείς για την ταλαιπωρία!

Η ώρα είναι 20:21.

Search Engine Optimization by vBSEO 3.3.2