Η NYARCH γράφει
Θέλω το Excel να αντιγράψει μια ολόκληρη σειρά σε ένα νέο φύλλο εργασίας του Excel βάσει μιας καταχώρησης κελιού. Για παράδειγμα, έχω δεδομένα στα κελιά A8: AG8, θέλω το Excel να αντιγράψει ολόκληρη τη σειρά στο φύλλο "a" εάν η τιμή στο H8 είναι "ir" και στο φύλλο "b" εάν η τιμή στο H8 είναι "RR". Το πιο περίπλοκο μέρος και όχι απλώς αντιγραμμένο, το χρειάζομαι αντιγραμμένο στην επόμενη κενή γραμμή στο φύλλο εργασίας. Από τις 150 σειρές περίπου, μόνο 15 περίπου κάθε τύπου θα αντιγραφούν πραγματικά σε ένα νέο φύλλο.
Το MrExcel θα απονείμει 50 πόντους μπόνους σε κάθε αναγνώστη που θυμάται το άρθρο του Lotus Magazine που προσφέρει 10 υπέροχες συμβουλές, όπου η συμβουλή # 4 ήταν "Χρησιμοποιήστε το πλήκτρο τερματισμού για να μετακινηθείτε στο τέλος ενός εύρους". Επιστρέφοντας στις μέρες του Lotus, θα μπορούσατε να βάλετε τον κινητό δείκτη οπουδήποτε σε ένα μπλοκ δεδομένων, να πατήσετε ΤΕΛΟΣ στη συνέχεια προς τα κάτω και ο δείκτης κελιού θα οδηγούσε στο τέλος του εύρους. Το Excel έχει παρόμοια λειτουργικότητα, το VBA έχει παρόμοια λειτουργικότητα και αυτό είναι το κλειδί για την εύρεση της τελευταίας σειράς δεδομένων σε ένα φύλλο.
Η τεχνική VBA είναι να χρησιμοποιήσετε το End (xlDown) για να προσομοιώσετε το πλήκτρο End + Down ή το End (xlUp) για να προσομοιώσετε το πλήκτρο End + Up. Πατώντας αυτήν την ακολουθία πλήκτρων θα μετακινηθεί ο δείκτης κελιού στο επόμενο άκρο ενός συνεχόμενου εύρους δεδομένων. Φανταστείτε ότι υπάρχουν τιμές στα A1: A10 και A20: A30. Ξεκινήστε από το Α1. Πατήστε End + Down και ο δείκτης κελιού μετακινείται στο A10. Πατήστε End + Down και πηγαίνετε στο A20, το οποίο είναι το πάνω άκρο της επόμενης γειτονικής σειράς δεδομένων. Πατήστε End + Down και θα πάτε στο A30. Είμαι στην πραγματικότητα χαμένη πώς να εξηγήσω αυτήν τη συμπεριφορά στα απλά αγγλικά. Απλώς δοκιμάστε το και θα δείτε πώς λειτουργεί.
Το κόλπο που χρησιμοποιώ είναι να ξεκινήσω από τη στήλη Α στην τελευταία σειρά του υπολογιστικού φύλλου και έπειτα να πατήσω το End + Up. Αυτό θα με οδηγήσει στην τελική σειρά με δεδομένα. Τότε ξέρω να χρησιμοποιήσω την επόμενη σειρά προς τα κάτω ως κενή σειρά.
Εδώ είναι μια μακροεντολή brute-force για την επίλυση του προβλήματος αυτής της εβδομάδας. Ναι, σίγουρα θα μπορούσατε να το κάνετε πιο κομψά με αυτόματο φίλτρο. Τα δεδομένα βρίσκονται επί του παρόντος στο Φύλλο1, με επικεφαλίδες στη σειρά 2.
Public Sub CopyRows() Sheets("Sheet1").Select ' Find the last row of data FinalRow = Range("A65536").End(xlUp).Row ' Loop through each row For x = 2 To FinalRow ' Decide if to copy based on column H ThisValue = Range("H" & x).Value If ThisValue = "ir" Then Range("A" & x & ":AG" & x).Copy Sheets("a").Select NextRow = Range("A65536").End(xlUp).Row + 1 Range("A" & NextRow).Select ActiveSheet.Paste Sheets("Sheet1").Select ElseIf ThisValue = "RR" Then Range("A" & x & ":AG" & x).Copy Sheets("b").Select NextRow = Range("A65536").End(xlUp).Row + 1 Range("A" & NextRow).Select ActiveSheet.Paste Sheets("Sheet1").Select End If Next x End SubΔεδομένου ότι το Excel 2007 έχει περισσότερες από 65.536 σειρές, θα μπορούσατε να χρησιμοποιήσετε αυτήν τη μακροεντολή, ώστε να είναι συμβατή προς τα εμπρός. Σημειώστε ότι χρησιμοποιώ CELLS (Row, Column) αντί για RANGE εδώ:
Public Sub CopyRows() Sheets("Sheet1").Select ' Find the last row of data FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' Loop through each row For x = 2 To FinalRow ' Decide if to copy based on column H ThisValue = Cells(x, 8).Value If ThisValue = "ir" Then Cells(x, 1).Resize(1, 33).Copy Sheets("a").Select NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(NextRow, 1).Select ActiveSheet.Paste Sheets("Sheet1").Select ElseIf ThisValue = "RR" Then Cells(x, 1).Resize(1, 33).Copy Sheets("b").Select NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(NextRow, 1).Select ActiveSheet.Paste Sheets("Sheet1").Select End If Next x End SubΓια συμβουλές σχετικά με τον τρόπο χρήσης μιας μακροεντολής, ανατρέξτε στο θέμα Παρουσίαση του Excel VBA Editor.
