[Γενικά] οριζοντια-καθετα

[dimzoozoo]

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

Επισυνάπτω συνημμένο!

ΕΥΧΑΡΙΣΤΩ ΠΟΛΥ

Μαρια.

[ShortCuter]

Αρχική Δημοσίευση από dimzoozoo

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

Επισυνάπτω συνημμένο!

ΕΥΧΑΡΙΣΤΩ ΠΟΛΥ

Μαρια.

Γειά χαρά Μαρία.
Η λύση είναι στην αυτοματοποίηση. Αντίγραψε τον παρακάτω κώδικα και επικόλλησέ τον στον project explorer σου στο ανάλογο φύλλο. Τον εμφανίζεις με Alt+F11.
Προσοχή στο να αρχίζουν τα δεδομένα από το κελί Α1 και δεξιά από τα δεδομένα της πρώτης γραμμής και κάτω από αυτά της πρώτης στήλης να έχει κενά κελιά διότι θα αρχίσει να αντιγράφει ό,τι να 'ναι όπου να 'ναι. Είναι προγραμματισμένο να ξεκινά την επικόλληση αφήνοντας μια κενή στήλη δεξιά της στήλης που τελειώνουν τα δεδομένα.
Το πρόγραμμα δεν λειτουργεί σε εκδόσεις πριν τη 2007 διότι έχει hardcoded αριθμούς που αντιστοιχούν σε αυτήν την έκδοση.

Option Explicit

Sub Transposition()

Dim CountRows, CountCols, StartCoord, RowCounter

CountRows = Cells(1048576, 1).End(xlUp).Row
CountCols = Cells(1, 16384).End(xlToLeft).Column
StartCoord = CountCols + 2

For RowCounter = 1 To CountRows
    Range(Cells(RowCounter, 1), Cells(RowCounter, CountCols)).Copy
    Cells(1 + (RowCounter - 1) * CountCols, StartCoord).PasteSpecial Paste:=xlPasteAll, Operation:= _
    xlNone, SkipBlanks:= False, Transpose:=True
Next RowCounter

End Sub

Παιδιά εννοείται ότι εάν υπάρχει καλλίτερη, ταχύτερη, εξυπνότερη λύση την παραθέτουμε.

Αδάμ

[dimzoozoo]

σε ευχαριστω πολυ ΑΔΑΜ.δουλεψε μια χαρα .
να σαι καλα.

[nisgia]

Γεια και χαρά σε όλους και όλες!

Αρχική Δημοσίευση από ShortCuter

Παιδιά εννοείται ότι εάν υπάρχει καλλίτερη, ταχύτερη, εξυπνότερη λύση την παραθέτουμε.

Μια ακόμη λύση θα ήταν η χρήση της λειτουργίας "Αντιγραφή-Ειδική επικόλληση"
με ενεργοποιημένο το "Αντιμετάθεση"(Transpose) ενώ με τον τρόπο της αυτοματοποίησης
και εφόσον δεν υπάρχουν κενές γραμμές στην "οριζόντια" περιοχή, θα μπορούσε να γίνει και έτσι:

Sub Transposition()
    With Range("A1").CurrentRegion
        .Copy
        .Offset(, .Columns.Count + 1).PasteSpecial , , , True
    End With
End Sub

Φίλε Αδάμ, χαίρομαι πολύ που ξαναβρεθήκαμε!

Τα λέμε,
Γιάννης

[ShortCuter]

Να 'σαι καλά φίλε nisgia. Θα τα λέμε από εδώ (στο μέτρο του δυνατού)!