Forum - Γενικά Τακτοποίηση δεδομένων

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

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

- - [Γενικά] Τακτοποίηση δεδομένων (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/6521-taktopoiisi-dedomenon.html)

Τακτοποίηση δεδομένων

Καλησπέρα, έχω 4 περιοχές με δεδομένα. Άλλη μία όπου θέλω να τα συγκεντρώνω.
Από τις 4 περιοχές(Sections 1 έως 4) θέλω ότι δεδομένα υπάρχουν στην στήλη με τίτλο 1 να συγκεντρωθούν στην περιοχή All Sections στην στήλη με τίτλο 1, αντίστοιχα και για τις υπόλοιπες στήλες.
Μετά από αρκετό ψάξιμο βρήκα μια συνάρτηση η οποία δείχνει να κάνει αυτό που χρειάζομαι.

Στην περιοχή με κίτρινο χρώμα έχω 4 στήλες, μία για κάθε section.
Εδώ θέλω στην στήλη με τίτλο Section 1 όλα τα δεδομένα που υπάρχουν στην περιοχή Section1 ανά στήλη(από στήλη με τίτλο 1 έως στήλη με τίτλο 20), χρησιμοποίησα την ίδια συνάρτηση, όμως μου δίνει τα δεδομένα κατά σειρά.

Υπάρχει τρόπος, άλλη συνάρτηση, ή οτιδήποτε άλλο το οποίο θα μου δώσει τα δεδομένα κατά στήλη;
Κάθε βοήθεια, διόρθωση, πρόταση δεκτη!
Σας ευχαριστώ

Καλησπέρα Νίκο,

Στη στήλη DC (Section 1) θέλεις να έχεις το παρακάτω αποτέλεσμα:

W1
W12
QW34
QW11
QW22
QW23

και όχι αυτό που υπάρχει στο συνημμένο παράδειγμα με τον συγκεκριμένο τύπο;

Δηλαδή κάθε στήλη section του κίτρινου πίνακα, να έχει τις 20 στήλες κάθε αντίστοιχου πίνακα section τη μία κάτω από την άλλη;

Ναι Χρήστο, πολύ σωστά!

Δοκίμασε τον παρακάτω κώδικα αν σε καλύπτει:

Κώδικας:

Option Explicit
 

Sub METAFORA()

    Dim SC As Byte

    Dim R1 As Long, R2 As Long

    Dim C1 As Long, C2 As Long

    

    Application.ScreenUpdating = False

    Range("DC3:DF" & Rows.Count).ClearContents

    

    For SC = 1 To 4

        R2 = 3

        For C1 = 2 + SC * 21 To 21 + SC * 21

            R1 = 3

            Do

                If Cells(R1, C1).Value = "" Then

                    R1 = 0

                Else

                    Cells(R2, Evaluate("MATCH(""Section ""&" & SC & ",2:2,0)")).Value = Cells(R1, C1).Value

                    R1 = R1 + 1

                    R2 = R2 + 1

                End If

            Loop While R1 > 0

        Next

    Next

    

    Application.ScreenUpdating = True

End Sub

Θεωρώ πως τα δεδομένα στις στήλες είναι συνεχόμενα (το ένα κάτω από το άλλο) και δεν παρεμβάλονται μεταξύ τους κενά κελιά.

Χρήστο σε ευχαριστώ, θα το δοκιμάσω κ θα σε ενημερώσω για το αποτέλεσμα.

Ότι θα ήθελε κάποιος να κανονίσει ραντεβού μέσα από κώδικα vba, και κρύβει το d a t i n g, ούτε που θα το φανταζόμουν :005::005::005:

Χρήστο δουλεύει άψογα! Να είσαι καλά!

Μία ερώτηση, σχετικά με τις ονομασίες Section 1 έως 4, εάν αντικαταστήσω το Section στο φύλλο αλλά και στο κομμάτι του κώδικα παρακάτω με άλλη λέξη π.χ. Τμήμα νομίζω πως δεν θα επηρεάσει την λειτουργία

Κώδικας:

Cells(R2, Evaluate("MATCH(""Τμήμα ""&" & SC & ",2:2,0)")).Value = Cells(R1, C1).Value

Επίσης, στην περίπτωση που θέλω να ακυρώσω την λέξη Section (ή Τμήμα) τελείως και να κρατήσω μόνο το 1 to 4, η τροποποίηση του κώδικα θα είναι πολύπλοκη;

Αν θελήσω να αλλάξω το 1 έως 4 σε Α Β Γ Δ; Είναι αυτό εφικτό; Και αν ναι, στο παρακάτω κομμάτι πως θα δηλώσω την αλλαγή αυτή;

Κώδικας:

For SC = 1 To 4

Για δοκίμασε αυτόν τον κώδικα καλύτερα:

Κώδικας:

Option Explicit
 

Sub METAFORA()

    Dim SC As Byte

    Dim R1 As Long, R2 As Long

    Dim C1 As Long, C2 As Long

    

    Application.ScreenUpdating = False

    Range("DC3:DF" & Rows.Count).ClearContents

    

    For SC = 1 To 4

        R2 = 3

        C2 = 106 + SC

        For C1 = 2 + SC * 21 To 21 + SC * 21

            R1 = 3

            Do

                If Cells(R1, C1).Value = "" Then

                    R1 = 0

                Else

                    Cells(R2, C2).Value = Cells(R1, C1).Value

                    R1 = R1 + 1

                    R2 = R2 + 1

                End If

            Loop While R1 > 0

        Next

    Next

    

    Application.ScreenUpdating = True

End Sub

Δεν υπάρχει πρόβλημα να αλλάξεις το Τμήμα, μιας και δεν υπάρχει πλέον στον κώδικα.

Η For...To... δέχεται μόνο αριθμούς, οπότε δεν μπορείς να χρησιμοποιήσεις γράμματα.

Καλημέρα!

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

Όσον αφορά την χθεσινή μου ερώτηση:

Παράθεση:

Αν θελήσω να αλλάξω το 1 έως 4 σε Α Β Γ Δ; Είναι αυτό εφικτό; Και αν ναι, στο παρακάτω κομμάτι πως θα δηλώσω την αλλαγή αυτή;

Κώδικας:

For SC = 1 To 4

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