Πώς να μετακινήσετε διπλές σειρές σε άλλο φύλλο στο Excel;
Εάν έχετε μια λίστα εύρους δεδομένων που περιέχει μερικές διπλές τιμές σε μια συγκεκριμένη στήλη, τώρα, θέλετε να μετακινήσετε ολόκληρες τις σειρές σε άλλο φύλλο με βάση τα διπλά κελιά. Πώς θα μπορούσατε να αντιμετωπίσετε αυτήν την εργασία στο Excel;
Μετακινήστε ολόκληρες σειρές σε άλλο φύλλο με βάση τα διπλά κελιά σε μια στήλη
Μετακίνηση ολόκληρων σειρών σε άλλο φύλλο με βάση διπλές σειρές
Μετακινήστε ολόκληρες σειρές σε άλλο φύλλο με βάση τα διπλά κελιά σε μια στήλη
Εάν υπάρχουν διπλές τιμές σε μια στήλη και μετακινήστε ολόκληρες τις σειρές σε άλλο φύλλο, ο ακόλουθος κώδικας VBA μπορεί να σας βοηθήσει:
1. Κρατήστε πατημένο το ALT + F11 για να ανοίξετε το Microsoft Visual Basic για εφαρμογές παράθυρο.
2. Κλίκ Κύριο θέμα > Μονάδα μέτρησηςκαι επικολλήστε τον ακόλουθο κώδικα στο παράθυρο Module.
Κωδικός VBA: Μετακίνηση ολόκληρων σειρών σε άλλο φύλλο με βάση διπλά κελιά σε μια στήλη:
Sub CutDuplicates()
'Updateby Extendoffice
Dim xRgS As Range
Dim xRgD As Range
Dim I As Long, J As Long
On Error Resume Next
Set xRgS = Application.InputBox("Please select the column:", "KuTools For Excel", Selection.Address, , , , , 8)
If xRgS Is Nothing Then Exit Sub
Set xRgD = Application.InputBox("Please select a desitination cell:", "KuTools For Excel", , , , , , 8)
If xRgD Is Nothing Then Exit Sub
xRows = xRgS.Rows.Count
J = 0
For I = xRows To 1 Step -1
If Application.WorksheetFunction.CountIf(xRgS, xRgS(I)) > 1 Then
xRgS(I).EntireRow.Copy xRgD.Offset(J, 0)
xRgS(I).EntireRow.Delete
J = J + 1
End If
Next
End Sub
3. Στη συνέχεια πατήστε F5 για να εκτελέσετε αυτόν τον κώδικα και στο αναδυόμενο παράθυρο διαλόγου, επιλέξτε τη στήλη που περιέχει τα διπλά κελιά στα οποία θέλετε να μετακινήσετε, δείτε το στιγμιότυπο οθόνης:
4. Στη συνέχεια κάντε κλικ στο κουμπί OK, σε ένα άλλο πλαίσιο προτροπής, επιλέξτε ένα κελί σε άλλο φύλλο όπου θέλετε να βάλετε τις μετακινούμενες σειρές, δείτε το στιγμιότυπο οθόνης:
5. Και στη συνέχεια κάντε κλικ στο κουμπί OK, οι γραμμές που έχουν διπλές τιμές στη στήλη Α έχουν μετακινηθεί σε ένα νέο φύλλο, δείτε το στιγμιότυπο οθόνης:
Μετακίνηση ολόκληρων σειρών σε άλλο φύλλο με βάση διπλές σειρές
Εάν θέλετε να μετακινήσετε τις διπλές σειρές από μια σειρά κελιών, ο ακόλουθος κώδικας VBA μπορεί να σας βοηθήσει:
1. Κρατήστε πατημένο το ALT + F11 για να ανοίξετε το Microsoft Visual Basic για εφαρμογές παράθυρο.
2. Κλίκ Κύριο θέμα > Μονάδα μέτρησηςκαι επικολλήστε τον ακόλουθο κώδικα στο παράθυρο Module.
Κωδικός VBA: Μετακίνηση ολόκληρων γραμμών σε άλλο φύλλο με βάση διπλές σειρές:
Sub CutDuplicates()
'Updateby Extendoffice
Dim xRgD As Range, xRgS As Range
Dim I As Long, J As Long, K As Long, KK As Long
On Error Resume Next
Set xRgS = Application.InputBox("Please select the data range:", "KuTools For Excel", Selection.Address, , , , , 8)
If xRgS Is Nothing Then Exit Sub
Set xRgD = Application.InputBox("Please select a desitination cell:", "KuTools For Excel", , , , , , 8)
If xRgD Is Nothing Then Exit Sub
KK = 0
For I = xRgS.Rows.Count To 1 Step -1
For J = 1 To I - 1
For K = 1 To xRgS.Columns.Count
Debug.Print xRgS.Rows(I).Cells(, K).Value
Debug.Print xRgS.Rows(J).Cells(, K).Value
If xRgS.Rows(I).Cells(, K).Value <> xRgS.Rows(J).Cells(, K).Value Then Exit For
Next
If K = xRgS.Columns.Count + 1 Then
xRgS.Rows(I).EntireRow.Copy xRgD.Offset(KK, 0).EntireRow
xRgS.Rows(I).EntireRow.Delete
KK = KK + 1
End If
Next
Next
End Sub
3. Στη συνέχεια πατήστε F5 για να εκτελέσετε αυτόν τον κώδικα, στο αναδυόμενο παράθυρο διαλόγου, επιλέξτε το εύρος δεδομένων που θέλετε να μετακινήσετε τις διπλές σειρές, δείτε το στιγμιότυπο οθόνης:
4. Κλίκ OK κουμπί και, στη συνέχεια, σε ένα άλλο πλαίσιο προτροπής, επιλέξτε ένα κελί σε ένα νέο φύλλο στο οποίο θέλετε να τοποθετήσετε τις μετακινούμενες σειρές, δείτε το στιγμιότυπο οθόνης
5. Στη συνέχεια κάντε κλικ στο κουμπί OK κουμπί και τώρα, οι διπλές σειρές έχουν μετακινηθεί σε άλλο φύλλο που καθορίσατε ταυτόχρονα, δείτε το στιγμιότυπο οθόνης:
Τα καλύτερα εργαλεία παραγωγικότητας γραφείου
Αυξήστε τις δεξιότητές σας στο Excel με τα Kutools για Excel και απολαύστε την αποτελεσματικότητα όπως ποτέ πριν. Το Kutools για Excel προσφέρει πάνω από 300 προηγμένες δυνατότητες για την ενίσχυση της παραγωγικότητας και την εξοικονόμηση χρόνου. Κάντε κλικ εδώ για να αποκτήσετε τη δυνατότητα που χρειάζεστε περισσότερο...
Το Office Tab φέρνει τη διεπαφή με καρτέλες στο Office και κάνει την εργασία σας πολύ πιο εύκολη
- Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
- Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
- Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
