Excel - Vba εισάγοντας σειρά και διατηρώντας την ιδιότητα μέλους

Θέμα

Στο VBA, πώς αντιγράφω / εισάγω (στη θέση) μια σειρά και βεβαιώνω ότι αν η γραμμή πηγής τέμνει ένα εύρος στήλης, η νέα σειρά θα είναι επίσης στο εύρος και το εύρος θα αυξηθεί κατά 1 (δηλ. .

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

Το xlUp και το xlDown δεν κάνουν τη διαφορά, ούτε αφήνουν τα έξω (το Excel λέει ότι είναι το καλύτερο που πρέπει να κάνετε αν έχετε διασταυρωμένες στήλες).

Λύση

Το καθιστώ εντελώς αυτόματο. Δεν χρειάζεται να ονομάσετε το εύρος. η μακροεντολή "test" το κάνει. μόνο η είσοδος που πρέπει να πληκτρολογήσετε είναι ότι πρέπει να πληκτρολογήσετε τον αριθμό της σειράς που πρόκειται να διαγραφεί για παράδειγμα 2 ή 3 ή 4 όταν εμφανιστεί το πλαίσιο εισαγωγής. Η μακροεντολή "αναίρεση" αναιρεί τι κάνει η μακροεντολή.

Η βάση δεδομένων είναι αυτή από A1 έως A5

1

2

3

4

5

μην κάνετε τίποτα απλώς εκτελέσετε τη μακροεντολή "test" (και οι δύο μακροεντολές πρέπει να αντιγραφούν στη μονάδα). Συγνώμη, αυτό έχει γίνει μια περίπλοκη μακροεντολή. Προσπάθησα να χρησιμοποιήσω "αλλαγή μεγέθους". με κάποιο τρόπο ή με άλλο δεν κατάφερα. Ίσως κάποιος ειδικός μπορεί να δώσει μια καλύτερη λύση. Αλλά αυτή η λύση λειτουργεί. αν θέλετε το εύρος της ονομαστικής περιοχής να είναι διαφορετικό, τροποποιήστε αυτήν τη δήλωση στη μακροεντολή "test" για να σας ταιριάξει

Εύρος ("A2: a4") Όνομα = "myrange"

Οι μακροεντολές είναι:

Μακροεντολή 1

 Sub test ()
Dim r As Range, j Ως ακέραιος, k Ως ακέραιος, m Ως ακέραιος
ξεκάνω
Εύρος ("A2: a4") Όνομα = "myrange"
Ρύθμιση r = Εύρος ("myrange")
m = Φύλλο εργασίας (r)
'MsgBox m
k = InputBox ("πληκτρολογήστε τον αριθμό της γραμμής που θα επιλεγεί")
Γραμμές (k) .Επιλέξτε
Ρύθμιση r = Εύρος ("myrange")
j = Εύρος ("myrange"). Κύτταρα (1, 1)
'MsgBox j
Επιλογή
Εάν η επιλογή Selection.Row = j Τότε
ActiveWorkbook.Names ("myrange") Διαγραφή
Εύρος (Κύτταρα (Επιλογή), Α), r.Cells (m, 1)) Όνομα = "myrange"
Τέλος εαν
Εύρος MsgBox ("myrange") Διεύθυνση
End Sub 

Macro 2

 Υποχωρητής ()
Dim r As Range, c As Range
Ρύθμιση r = Εύρος (Εύρος ("A1"), Κύτταρα (Rows.Count, "A") Τέλος (xlUp))
Για κάθε c Στο r
Αν c = "" Στη συνέχεια c.EntireRow.Delete
Επόμενο c
End Sub 

Σημείωση

Χάρη στο venkat1926 για αυτό το άκρη