Forum

Αναζήτηση στο ms-office.gr

Πάμε!
ms-office.gr > Forum > Microsoft Excel > Excel - Ερωτήσεις / Απαντήσεις > [Γενικά] Μετακίνηση εγγραφών

Excel - Ερωτήσεις / Απαντήσεις Ότι έχει σχέση με συναρτήσεις, μορφοποίηση, εκτυπώσεις γραφήματα κτλ.

Απάντηση στο θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 13-10-19, 13:28
Όνομα: ΔΗΜΗΤΡΗΣ
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Αγγλική
 
Εγγραφή: 01-08-2011
Μηνύματα: 83
Προεπιλογή Μετακίνηση εγγραφών

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

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

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

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

Σας ευχαριστώ πολύ!
Συνημμένα Αρχεία
Τύπος Αρχείου: xlsm ΜΕΤΑΚΙΝΗΣΗ ΠΑΝΩ ΚΑΤΩ.xlsm (19,5 KB, 15 εμφανίσεις)

Τελευταία επεξεργασία από το χρήστη ΔΗΜΗΤΡΙΟΣ : 13-10-19 στις 15:08.
Απάντηση με παράθεση
  #2  
Παλιά 13-10-19, 20:34
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.044
Προεπιλογή

Καλησπέρα

Δημήτρη, δες μια πρόταση στο συνημμένο.
Συνημμένα Αρχεία
Τύπος Αρχείου: xlsm offset.xlsm (37,0 KB, 19 εμφανίσεις)
Απάντηση με παράθεση
  #3  
Παλιά 13-10-19, 22:39
Το avatar του χρήστη Spirosgr
Συντονιστής
Όνομα: Σπύρος Τσιλιγιάννης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010, Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 22-11-2011
Περιοχή: Αθήνα
Μηνύματα: 2.402
Προεπιλογή

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

Αρκεί να διαγράψουμε την περιοχή κελιών:
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 του παραδείγματος
Απάντηση με παράθεση
  #4  
Παλιά 14-10-19, 06:42
Όνομα: ΔΗΜΗΤΡΗΣ
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Αγγλική
 
Εγγραφή: 01-08-2011
Μηνύματα: 83
Προεπιλογή

Καλημέρα σας .
Σας ευχαριστώ πολύ!
Απάντηση με παράθεση
  #5  
Παλιά 14-10-19, 08:18
Το avatar του χρήστη Spirosgr
Συντονιστής
Όνομα: Σπύρος Τσιλιγιάννης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010, Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 22-11-2011
Περιοχή: Αθήνα
Μηνύματα: 2.402
Προεπιλογή

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

Τι κάνει
Αν στη γραμμή 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 του παραδείγματος
Απάντηση με παράθεση
  #6  
Παλιά 14-10-19, 09:30
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.044
Προεπιλογή

Καλημέρα

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

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

Η γραμμή κώδικα: 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
Απάντηση με παράθεση
  #7  
Παλιά 14-10-19, 09:41
Το avatar του χρήστη Spirosgr
Συντονιστής
Όνομα: Σπύρος Τσιλιγιάννης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010, Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 22-11-2011
Περιοχή: Αθήνα
Μηνύματα: 2.402
Προεπιλογή

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

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

Το σωστό είναι, τα δεδομένα να έχουν στο τέλος την μορφή της εικόνας,
για να υπάρχει νόημα...
Συνημμένα Thumbnails
Μετακίνηση  εγγραφών-screenshot_1.jpg  
Απάντηση με παράθεση
  #8  
Παλιά 14-10-19, 17:10
Όνομα: ΔΗΜΗΤΡΗΣ
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Αγγλική
 
Εγγραφή: 01-08-2011
Μηνύματα: 83
Προεπιλογή

Είσαστε πολύ καλοί και οι δύο.
Μας βοηθάτε πολύ.
Ευχαριστούμε!!
Απάντηση με παράθεση
  #9  
Παλιά 16-10-19, 10:51
Το avatar του χρήστη Tasos
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 2007, Ms-Office 2010, Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.026
Προεπιλογή

Καλημέρα!

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


Κώδικας:
    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
Καλή συνέχεια σε όλους!

Τάσος
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών σε VB.Net, Access, Excel, Outlook, Word
Απάντηση με παράθεση
  #10  
Παλιά 16-10-19, 17:33
Το avatar του χρήστη Tasos
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 2007, Ms-Office 2010, Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.026
Προεπιλογή

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

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

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

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

Κώδικας:
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: Ο κώδικας στο προηγούμενο μου μήνυμα είναι τμήμα της ρουτίνας που αναγράφεται παραπάνω.

Καλή συνέχεια!
Τάσος
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών σε VB.Net, Access, Excel, Outlook, Word

Τελευταία επεξεργασία από το χρήστη Tasos : 16-10-19 στις 18:28.
Απάντηση με παράθεση
Απάντηση στο θέμα

Εργαλεία Θεμάτων
Τρόποι εμφάνισης

Δικαιώματα - Επιλογές
Δε μπορείτε να δημοσιεύσετε νέα μηνύματα
Δε μπορείτε να δημοσιεύσετε απαντήσεις
Δεν μπορείτε να επισυνάψετε αρχεία
Δεν μπορείτε να επεξεργαστείτε τα μηνύματα σας

Ο κώδικας ΒΒ είναι σε λειτουργία
Τα Smilies είναι σε λειτουργία
Ο κώδικας [IMG] είναι σε λειτουργία
Ο κώδικας HTML είναι εκτός λειτουργίας
Trackbacks are εκτός λειτουργίας
Pingbacks are εκτός λειτουργίας
Refbacks are εκτός λειτουργίας


Παρόμοια Θέματα

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
[VBA] μετακίνηση σε πολλά κελιά μαζί kolekas Excel - Ερωτήσεις / Απαντήσεις 2 23-10-15 12:36
[Excel07] μετακίνηση γραμμης με διπλό clik kolekas Excel - Ερωτήσεις / Απαντήσεις 15 17-10-15 11:11
Μετακίνηση με ροδέλα ποντικιού Άλκης 71 Access - Ερωτήσεις / Απαντήσεις 0 05-11-14 08:45
Μετακίνηση αρχείου μέσω vba Χρήστος Access - Ερωτήσεις / Απαντήσεις 5 28-11-13 20:09
Μετακίνηση κέρσορα σε πεδία φόρμας dimnot Word - Ερωτήσεις / Απαντήσεις 2 11-10-11 19:41


Η ώρα είναι 18:27.