Excel - Ερωτήσεις / Απαντήσεις Ότι έχει σχέση με συναρτήσεις, μορφοποίηση, εκτυπώσεις γραφήματα κτλ. |
| Εργαλεία Θεμάτων | Τρόποι εμφάνισης |
#1
| |||
| |||
Μετακίνηση εγγραφών
Θα ήθελα αν γίνεται το επώνυμο -όνομα να ευθυγραμμιστεί με τους αριθμούς . Αυτό να γίνει είτε με μετακίνηση του επώνυμου-ονόματος προς τα κάτω είτε μετακίνηση των αριθμων προς τα πάνω. Επίσης η προηγούμενη σειρά να διαγραφεί και να μην έχω κενές γραμμές Θα ήθελα αν γίνεται με vba και χωρίς vba. Σας ευχαριστώ πολύ! Τελευταία επεξεργασία από το χρήστη ΔΗΜΗΤΡΙΟΣ : 13-10-19 στις 14:08. |
#2
| |||
| |||
Καλησπέρα Δημήτρη, δες μια πρόταση στο συνημμένο. |
#3
|
Καλησπέρα Θεωρώ, ότι το ζητούμενο, είναι πιο απλό απ' ότι φαίνεται... Αρκεί να διαγράψουμε την περιοχή κελιών: 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
| |||
| |||
Καλημέρα σας . Σας ευχαριστώ πολύ! |
#5
|
Καλημέρα Ο κώδικας ολοκληρωμένος, για όσους μας διαβάζουν κι έχουν παρόμοιο θέμα. Τι κάνει Αν στη γραμμή 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 Αν δεν θέλετε να εκτελείται στο ενεργό φύλλο, αλλά σε κάποιο άλλο, αντικαταστήστε παντού, το ActiveSheet, με το κωδικό όνομα του φύλλου σας. *Τα πιο πάνω ισχύουν για το συγκεκριμένο layout του παραδείγματος |
#6
| |||
| |||
Καλημέρα Κατά τη γνώμη ο κώδικας που αναρτήθηκε από το Σπύρο, μάλλον περιέχει ένα λάθος. Συγκεκριμένα: Η γραμμή κώδικα: 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
|
Δεν υπάρχει κανένα λάθος! Στο παράδειγμα, η τελευταία γραμμή (71) είναι όνομα, χωρίς τους αριθμούς της από κάτω (72). Αυτό προφανώς είναι τυχαίο, διότι ο Δημήτρης ανέβασε ένα τμήμα δεδομένων. Το σωστό είναι, τα δεδομένα να έχουν στο τέλος την μορφή της εικόνας, για να υπάρχει νόημα... |
#8
| |||
| |||
Είσαστε πολύ καλοί και οι δύο. Μας βοηθάτε πολύ. Ευχαριστούμε!! |
#9
| ||||
| ||||
Καλημέρα! Για τη διαγραφή γραμμών με βάση τα κενά κελιά στη στήλη Β θα πρότεινα: Κώδικας: 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 Ανάπτυξη επαγγελματικών εφαρμογών |
#10
| ||||
| ||||
Δημήτρη εσύ θα μας πεις τι γίνεται με τους αριθμούς. Κατά τη γνώμη μου στη στήλη Α πρόκειται για αρίθμηση γραμμών του και όχι εγγραφών. Γενικότερα, ο α/α που διορθώνεται και διαφοροποιείται από τον αρχικό παύει να θεωρείται α/α. Αν παρόλα αυτά χρειαστεί αρίθμηση εκ νέου τότε γράφουμε: Κώδικας: 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 Καλή συνέχεια! Τάσος
__________________ Ms-Office Development Team Ανάπτυξη επαγγελματικών εφαρμογών Τελευταία επεξεργασία από το χρήστη Tasos : 16-10-19 στις 17:28. |
« Προηγούμενο Θέμα
|
Επόμενο Θέμα »
Εργαλεία Θεμάτων | |
Τρόποι εμφάνισης | |
| |
Παρόμοια Θέματα | ||||
Θέμα | Δημιουργός | Forum | Απαντήσεις | Τελευταίο Μήνυμα |
[VBA] μετακίνηση σε πολλά κελιά μαζί | kolekas | Excel - Ερωτήσεις / Απαντήσεις | 2 | 23-10-15 11:36 |
[Excel07] μετακίνηση γραμμης με διπλό clik | kolekas | Excel - Ερωτήσεις / Απαντήσεις | 15 | 17-10-15 10:11 |
Μετακίνηση με ροδέλα ποντικιού | Άλκης 71 | Access - Ερωτήσεις / Απαντήσεις | 0 | 05-11-14 07:45 |
Μετακίνηση αρχείου μέσω vba | Χρήστος | Access - Ερωτήσεις / Απαντήσεις | 5 | 28-11-13 19:09 |
Μετακίνηση κέρσορα σε πεδία φόρμας | dimnot | Word - Ερωτήσεις / Απαντήσεις | 2 | 11-10-11 18:41 |
Η ώρα είναι 19:52.