Σε αυτό το άρθρο, θα δημιουργήσουμε μια μακροεντολή για μια ένωση πολλαπλών περιοχών σε ένα καθορισμένο φύλλο.
Τα ακατέργαστα δεδομένα αποτελούνται από ορισμένα δείγματα δεδομένων, τα οποία περιλαμβάνουν όνομα και ηλικία. Έχουμε δύο περιοχές που περιέχουν ακατέργαστα δεδομένα. Θέλουμε μια ένωση και των δύο περιοχών στο φύλλο "Προορισμός".
Κάνοντας κλικ στο κουμπί "Αντιγραφή εγγραφής" θα γίνει η ένωση δεδομένων και από τις δύο περιοχές, μαζί με τη μορφοποίηση.
Κάνοντας κλικ στο κουμπί "Αντιγραφή μόνο τιμής" θα γίνει επίσης η ένωση δεδομένων και από τις δύο περιοχές, χωρίς όμως να αντιγραφεί η μορφή του κελιού.
Επεξήγηση κώδικα
Για κάθε Smallrng In Sheets ("Main"). Range ("A9: B13, D16: E20"). Περιοχές
Επόμενο Smallrng
Το παραπάνω Για κάθε βρόχο χρησιμοποιείται για βρόχο σε καθορισμένες περιοχές.
Ορισμός DestRange = Φύλλα ("Προορισμός"). Εύρος ("A" & LastRow)
Ο παραπάνω κώδικας χρησιμοποιείται για τη δημιουργία ενός αντικειμένου εύρους του τελευταίου κελιού, όπου θέλουμε να αντιγράψουμε τα δεδομένα.
Smallrng.Copy DestRange
Ο παραπάνω κώδικας χρησιμοποιείται για την αντιγραφή δεδομένων στον καθορισμένο προορισμό.
Ακολουθήστε παρακάτω για τον κωδικό
Option Explicit Sub CopyMultiArea () 'Δήλωση μεταβλητών Dim DestRange As Range Dim Smallrng As Range Dim LastRow As Long' Looping through καθορισμένες περιοχές για κάθε Smallrng In Sheets ("Main"). Range ("A9: B13, D16: E20"). Περιοχές 'Εύρεση του αριθμού σειράς του τελευταίου κελιού LastRow = Φύλλα ("Προορισμός"). Εύρος ("A1"). SpecialCells (xlLastCell). Σειρά + 1' Επιλογή του κελιού όπου πρέπει να αντιγραφούν οι εγγραφές Εάν LastRow = 2 Στη συνέχεια ορίστε DestRange = Φύλλα ("Προορισμός"). Εύρος ("A" & LastRow - 1) Άλλο Σετ DestRange = Φύλλα ("Προορισμός"). Εύρος ("A" & LastRow) Τέλος Αν "Αντιγραφή εγγραφών σε καθορισμένο εύρος προορισμού Smallrng. Αντιγραφή DestRange Επόμενο Smallrng End Sub Sub CopyMultiAreaValues () 'Δήλωση μεταβλητών Dim DestRange As Range Dim Smallrng As Range Dim LastRow As Long' Looping through καθορισμένες περιοχές για κάθε Smallrng In Sheets ("Main"). Range ("A9: B13, D16: E20" ). Περιοχές 'Εύρεση του αριθμού σειράς του τελευταίου κελιού LastRow = Φύλλα ("Προορισμός"). Εύρος ("A1"). SpecialCells (xlLastCell). Σειρά + 1 Με Smallrng "Επιλογή του κελιού όπου Τα καλώδια πρέπει να αντιγραφούν Εάν LastRow = 2 Στη συνέχεια ορίστε DestRange = Φύλλα ("Προορισμός"). Εύρος ("A" & LastRow - 1). Αλλαγή μεγέθους (.Rows.Count, .Columns.Count) Άλλο Set DestRange = Φύλλα (" Περιοχή ("A" & LastRow). Αλλαγή μεγέθους (.Rows.Count, .Columns.Count) Τέλος αν τελειώσει με "Εκχώρηση των τιμών από την πηγή στον προορισμό DestRange.Value = Smallrng.Value Next Smallrng End Sub
Αν σας άρεσε αυτό το blog, μοιραστείτε το με τους φίλους σας στο Facebook. Επίσης, μπορείτε να μας ακολουθήσετε στο Twitter και το Facebook.
Θα θέλαμε πολύ να σας ακούσουμε, ενημερώστε μας πώς μπορούμε να βελτιώσουμε το έργο μας και να το κάνουμε καλύτερο για εσάς. Γράψτε μας στον ιστότοπο email