Πώς να μεταφέρετε κελιά σε μια στήλη με βάση μοναδικές τιμές σε μια άλλη στήλη;

Ας υποθέσουμε, έχετε μια σειρά δεδομένων που περιέχει δύο στήλες, τώρα, θέλετε να μεταφέρετε κελιά σε μία στήλη σε οριζόντιες σειρές με βάση μοναδικές τιμές σε μια άλλη στήλη για να λάβετε το ακόλουθο αποτέλεσμα. Έχετε καλές ιδέες για την επίλυση αυτού του προβλήματος στο Excel;

Μεταφέρετε κελιά σε μία στήλη με βάση μοναδικές τιμές με τύπους

Μεταφέρετε κελιά σε μία στήλη με βάση μοναδικές τιμές με κώδικα VBA

Μεταφέρετε κελιά σε μία στήλη με βάση μοναδικές τιμές με το Kutools για Excel

Μεταφέρετε κελιά σε μία στήλη με βάση μοναδικές τιμές με τύπους

Με τους ακόλουθους τύπους πίνακα, μπορείτε να εξαγάγετε τις μοναδικές τιμές και να μεταφέρετε τα αντίστοιχα δεδομένα τους σε οριζόντιες σειρές, κάντε τα εξής:

1. Εισαγάγετε αυτόν τον τύπο πίνακα: = INDEX ($ A $ 2: $ A $ 16, ΑΛΛΑΓΗ (0, COUNTIF ($ D $ 1: $ D1, $ A $ 2: $ A $ 16), 0)) σε ένα κενό κελί, D2, για παράδειγμα, και πατήστε Shift + Ctrl + Enter πλήκτρα μαζί για να λάβετε το σωστό αποτέλεσμα, δείτε το στιγμιότυπο οθόνης:

Σημείωση: Στον παραπάνω τύπο, A2: A16 είναι η στήλη από την οποία θέλετε να παραθέσετε τις μοναδικές τιμές και D1 είναι το κελί πάνω από αυτό το κελί τύπου.

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

3. Και μετά συνεχίστε να εισάγετε αυτόν τον τύπο στο κελί E2: =IFERROR(INDEX($B$2:$B$16, MATCH(0, COUNTIF($D2:D2,$B$2:$B$16)+IF($A$2:$A$16<>$D2, 1, 0), 0)), 0)και θυμηθείτε να πατήσετε Shift + Ctrl + Enter για να λάβετε το αποτέλεσμα, δείτε το στιγμιότυπο οθόνης:

Σημείωση: Στον παραπάνω τύπο: Β2: Β16 είναι τα δεδομένα στηλών που θέλετε να μεταφέρετε, A2: A16 είναι η στήλη στην οποία θέλετε να μεταφέρετε τις τιμές με βάση και D2 περιέχει τη μοναδική τιμή που έχετε εξαγάγει στο Βήμα 1.

4. Στη συνέχεια, σύρετε τη λαβή πλήρωσης προς τα δεξιά των κελιών που θέλετε να παραθέσετε τα μεταφερόμενα δεδομένα έως ότου εμφανιστούν 0, δείτε το στιγμιότυπο οθόνης:

5. Και στη συνέχεια συνεχίστε να σύρετε τη λαβή πλήρωσης προς τα κάτω στο εύρος των κελιών για να λάβετε τα μεταφερόμενα δεδομένα όπως φαίνεται το ακόλουθο στιγμιότυπο οθόνης:

Μεταφέρετε κελιά σε μία στήλη με βάση μοναδικές τιμές με κώδικα VBA

Ίσως οι τύποι να είναι περίπλοκοι για να καταλάβετε, εδώ, μπορείτε να εκτελέσετε τον ακόλουθο κώδικα VBA για να λάβετε το επιθυμητό αποτέλεσμα που χρειάζεστε.

1. Κρατήστε πατημένο το ALT + F11 για να ανοίξετε το Microsoft Visual Basic για εφαρμογές παράθυρο.

2. Κλίκ Κύριο θέμα > Μονάδα μέτρησηςκαι επικολλήστε τον ακόλουθο κώδικα στο Μονάδα μέτρησης Παράθυρο.

Κωδικός VBA: Μεταφέρετε κελιά σε μία στήλη με βάση μοναδικές τιμές σε μια άλλη στήλη:

Sub transposeunique()
'updateby Extendoffice
    Dim xLRow As Long
    Dim i As Long
    Dim xCrit As String
    Dim xCol  As New Collection
    Dim xRg As Range
    Dim xOutRg As Range
    Dim xTxt As String
    Dim xCount As Long
    Dim xVRg As Range
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("please select data range(only two columns):", "Kutools for Excel", xTxt, , , , , 8)
    Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
    If xRg Is Nothing Then Exit Sub
    If (xRg.Columns.Count <> 2) Or _
       (xRg.Areas.Count > 1) Then
        MsgBox "the used range is only one area with two columns ", , "Kutools for Excel"
        Exit Sub
    End If
    Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
    If xOutRg Is Nothing Then Exit Sub
    Set xOutRg = xOutRg.Range(1)
    xLRow = xRg.Rows.Count
    For i = 2 To xLRow
        xCol.Add xRg.Cells(i, 1).Value, xRg.Cells(i, 1).Value
    Next
    Application.ScreenUpdating = False
    For i = 1 To xCol.Count
        xCrit = xCol.Item(i)
        xOutRg.Offset(i, 0) = xCrit
        xRg.AutoFilter Field:=1, Criteria1:=xCrit
        Set xVRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)
        If xVRg.Count > xCount Then xCount = xVRg.Count
        xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible).Copy
        xOutRg.Offset(i, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
    Next
    xOutRg = xRg.Cells(1, 1)
    xOutRg.Offset(0, 1).Resize(1, xCount) = xRg.Cells(1, 2)
    xRg.Rows(1).Copy
    xOutRg.Resize(1, xCount + 1).PasteSpecial Paste:=xlPasteFormats
    xRg.AutoFilter
    Application.ScreenUpdating = True
End Sub

3. Στη συνέχεια πατήστε F5 κλειδί για την εκτέλεση αυτού του κώδικα και θα εμφανιστεί ένα πλαίσιο προτροπής για να σας υπενθυμίσει ότι επιλέγετε το εύρος δεδομένων που θέλετε να χρησιμοποιήσετε, δείτε το στιγμιότυπο οθόνης:

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

6. Κλίκ OK κουμπί και τα δεδομένα στη στήλη Β έχουν μεταφερθεί με βάση μοναδικές τιμές στη στήλη Α, δείτε το στιγμιότυπο οθόνης:

Μεταφέρετε κελιά σε μία στήλη με βάση μοναδικές τιμές με το Kutools για Excel

Εάν έχετε Kutools για Excel, συνδυάζοντας το Σύνθετες σειρές συνδυασμού και Διαίρεση κελιών βοηθητικά προγράμματα, μπορείτε να ολοκληρώσετε γρήγορα αυτήν την εργασία χωρίς τύπους ή κώδικα.

Μετά την εγκατάσταση Kutools για Excel, κάντε τα εξής:

1. Επιλέξτε το εύρος δεδομένων που θέλετε να χρησιμοποιήσετε. (Αν θέλετε να διατηρήσετε τα αρχικά δεδομένα, πρώτα αντιγράψτε και επικολλήστε τα δεδομένα σε άλλη τοποθεσία.)

2. Στη συνέχεια κάντε κλικ στο κουμπί Kutools > Συγχώνευση & διαχωρισμός > Σύνθετες σειρές συνδυασμού, δείτε το στιγμιότυπο οθόνης:

3. Στην Συνδυάστε σειρές με βάση τη στήλη πλαίσιο διαλόγου, κάντε τις ακόλουθες λειτουργίες:

(1.) Κάντε κλικ στο όνομα της στήλης στην οποία θέλετε να μεταφέρετε δεδομένα βάσει και επιλέξτε Πρωτεύων κλειδί;

(2.) Κάντε κλικ σε μια άλλη στήλη που θέλετε να μεταφέρετε και κάντε κλικ στο Συνδυασμός Στη συνέχεια, επιλέξτε ένα διαχωριστικό για να διαχωρίσετε τα συνδυασμένα δεδομένα, όπως διάστημα, κόμμα, ερωτηματικό.

4. Στη συνέχεια κάντε κλικ στο κουμπί Ok κουμπί, τα δεδομένα στη στήλη Β έχουν συνδυαστεί σε ένα κελί με βάση τη στήλη Α, δείτε το στιγμιότυπο οθόνης:

5. Στη συνέχεια, επιλέξτε τα συνδυασμένα κελιά και κάντε κλικ στο Kutools > Συγχώνευση & διαχωρισμός > Διαίρεση κελιών, δείτε το στιγμιότυπο οθόνης:

6. Στην Διαίρεση κελιών , επιλέξτε Διαχωρισμός σε στήλες σύμφωνα με το Χαρακτηριστικά και, στη συνέχεια, επιλέξτε το διαχωριστικό που διαχωρίζει τα συνδυασμένα δεδομένα σας, δείτε το στιγμιότυπο οθόνης:

7. Στη συνέχεια κάντε κλικ στο κουμπί Ok κουμπί και επιλέξτε ένα κελί για να βάλετε το αποτέλεσμα διαχωρισμού στο αναδυόμενο παράθυρο διαλόγου, δείτε το στιγμιότυπο οθόνης:

8. Κλίκ OKκαι θα λάβετε το αποτέλεσμα όπως χρειάζεστε. Δείτε το στιγμιότυπο οθόνης:

Κατεβάστε και δωρεάν δοκιμή Kutools για Excel τώρα!

Επίδειξη: Μεταφέρετε κελιά σε μία στήλη με βάση μοναδικές τιμές με το Kutools για Excel