Forum - Γενικά Μετακίνηση εγγραφών

Σελίδα 1 από 2

Εμφάνιση 40 μηνυμάτων αυτού του θέματος σε μία σελίδα

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/5362-metakinisi-eggrafon.html)

ΔΗΜΗΤΡΙΟΣ

13-10-19 12:28

Μετακίνηση εγγραφών

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

Θα ήθελα αν γίνεται το επώνυμο -όνομα να ευθυγραμμιστεί με τους αριθμούς .

Αυτό να γίνει είτε με μετακίνηση του επώνυμου-ονόματος προς τα κάτω είτε μετακίνηση των αριθμων προς τα πάνω.

Επίσης η προηγούμενη σειρά να διαγραφεί και να μην έχω κενές γραμμές

Θα ήθελα αν γίνεται με vba και χωρίς vba.

Σας ευχαριστώ πολύ!

kapetang

13-10-19 19:34

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

Καλησπέρα

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

Spirosgr

13-10-19 21:39

Καλησπέρα
Θεωρώ, ότι το ζητούμενο, είναι πιο απλό απ' ότι φαίνεται...

Αρκεί να διαγράψουμε την περιοχή κελιών:
d1:m1

Με ενεργό το φύλλο ΚΑΤΑΣΤΑΣΗ-1, τρέχουμε μια γραμμή κώδικα.

Κώδικας:

Sub Macro1()

    ActiveSheet.Range("d1:m1").Delete Shift:=xlUp

End Sub

Τώρα:
Αν θέλουμε να κλειδώσουμε τον κώδικα και να μην τρέξει ξανα αν
η πρώτη γραμμή είναι πλήρης, βάζουμε:

Κώδικας:

Sub Macro1()

If WorksheetFunction.CountA(Range("d1:m1")) = 0 Then _

    ActiveSheet.Range("d1:m1").Delete Shift:=xlUp

End Sub

Οι κενές γραμμές που υπάρχουν ανάμεσα στις εγγραφές,
μπορούν να φύγουν με τον ίδιο περίπου τρόπο.
Απλά πρέπει να ξεκινήσεις να διαγράφεις από κάτω προς τα πάνω...
Δοκίμασέ να το φτιάξεις μόνος σου με step - ... και αν δεν το καταφέρεις μιλάμε.

*Τα πιο πάνω ισχύουν για το συγκεκριμένο layout του παραδείγματος

ΔΗΜΗΤΡΙΟΣ

14-10-19 05:42

Καλημέρα σας .
Σας ευχαριστώ πολύ!

Spirosgr

14-10-19 07:18

Καλημέρα
Ο κώδικας ολοκληρωμένος, για όσους μας διαβάζουν κι έχουν παρόμοιο θέμα.

Τι κάνει
Αν στη γραμμή 1, το τμήμα d1:m1 είναι κενό, τότε:
1.Ευθυγραμμίζει τις εγγραφές
2.Διαγράφει τις ενδιάμεσες κενές γραμμές
3.Διορθώνει τον α/α

Κώδικας:

Sub FixData()

    If WorksheetFunction.CountA(Range("d1:m1")) = 0 Then

        ActiveSheet.Range("d1:m1").Delete Shift:=xlUp

    Else

        Exit Sub

    End If
 

    Dim lrow As Long, i As Long

    lrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
 

    Application.ScreenUpdating = False
 

    For i = lrow To 2 Step -2

        ActiveSheet.Rows(i).Delete Shift:=xlUp

        ActiveSheet.Cells(i - 1, 1).Value = (ActiveSheet.Cells(i - 1, 1).Value + 1) / 2

    Next i

End Sub

Προσαρμόστε ανάλογα, με τις ανάγκες σας για διαφορετικό layout...

Αν δεν θέλετε να εκτελείται στο ενεργό φύλλο, αλλά σε κάποιο άλλο,
αντικαταστήστε παντού, το ActiveSheet, με το κωδικό όνομα του φύλλου σας.

*Τα πιο πάνω ισχύουν για το συγκεκριμένο layout του παραδείγματος

kapetang

14-10-19 08:30

Καλημέρα

Κατά τη γνώμη ο κώδικας που αναρτήθηκε από το Σπύρο, μάλλον περιέχει ένα λάθος.

Συγκεκριμένα:

Η γραμμή κώδικα: lrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row, θα εντοπίσει τον αριθμό της γραμμής του τελευταίου ονόματος (ΧΑΤΖΗΚΩΝΣΤΑΝΤΗΣ).

Στη συνέχεια ο βρόχος: For i = lrow To 2 Step -2, αρχίζοντας από το τελευταίο όνομα και προχωρώντας προς τα πάνω, θα διαγράφει γραμμές με ονόματα και όχι κενές.

Προτείνω η σχετική γραμμή να γίνει:

lrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

Spirosgr

14-10-19 08:41

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

Δεν υπάρχει κανένα λάθος!

Στο παράδειγμα, η τελευταία γραμμή (71) είναι όνομα,
χωρίς τους αριθμούς της από κάτω (72).
Αυτό προφανώς είναι τυχαίο, διότι ο Δημήτρης ανέβασε ένα τμήμα δεδομένων.

Το σωστό είναι, τα δεδομένα να έχουν στο τέλος την μορφή της εικόνας,
για να υπάρχει νόημα...

ΔΗΜΗΤΡΙΟΣ

14-10-19 16:10

Είσαστε πολύ καλοί και οι δύο.
Μας βοηθάτε πολύ.
Ευχαριστούμε!!

Tasos

16-10-19 09:51

Καλημέρα!

Για τη διαγραφή γραμμών με βάση τα κενά κελιά στη στήλη Β θα πρότεινα:

Κώδικας:

    With Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(, 1)

        If WorksheetFunction.CountBlank(.Cells) Then

            .SpecialCells(xlCellTypeBlanks).EntireRow.Delete

        End If

    End With

Καλή συνέχεια σε όλους!

Τάσος

Tasos

16-10-19 16:33

Δημήτρη εσύ θα μας πεις τι γίνεται με τους αριθμούς.

Κατά τη γνώμη μου στη στήλη Α πρόκειται για αρίθμηση γραμμών του και όχι εγγραφών.

Γενικότερα, ο α/α που διορθώνεται και διαφοροποιείται από τον αρχικό παύει να θεωρείται α/α.

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

Κώδικας:

Sub test()

    If WorksheetFunction.CountA(Range("d1:m1")) = 0 Then

        ActiveSheet.Range("d1:m1").Delete Shift:=xlUp

        With Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(, 1)

            If WorksheetFunction.CountBlank(.Cells) Then

                .SpecialCells(xlCellTypeBlanks).EntireRow.Delete

            End If

        End With

        Cells(1, 1).Value = 1

        Cells(1, 1).AutoFill Destination:=Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)), Type:=xlFillSeries

    End If

End Sub

Edit: Ο κώδικας στο προηγούμενο μου μήνυμα είναι τμήμα της ρουτίνας που αναγράφεται παραπάνω.

Καλή συνέχεια!
Τάσος

Η ώρα είναι 02:35.

Σελίδα 1 από 2

Εμφάνιση 40 μηνυμάτων αυτού του θέματος σε μία σελίδα

Search Engine Optimization by vBSEO 3.3.2