Note: The other languages of the website are Google-translated. Back to English

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

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

doc μεταφέρει μοναδικές τιμές 1

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

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

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


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

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

doc μεταφέρει μοναδικές τιμές 2

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

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

doc μεταφέρει μοναδικές τιμές 3

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 για να λάβετε το αποτέλεσμα, δείτε το στιγμιότυπο οθόνης:

doc μεταφέρει μοναδικές τιμές 4

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

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

doc μεταφέρει μοναδικές τιμές 5

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

doc μεταφέρει μοναδικές τιμές 6


Ίσως οι τύποι να είναι περίπλοκοι για να καταλάβετε, εδώ, μπορείτε να εκτελέσετε τον ακόλουθο κώδικα 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 κλειδί για την εκτέλεση αυτού του κώδικα και θα εμφανιστεί ένα πλαίσιο προτροπής για να σας υπενθυμίσει ότι επιλέγετε το εύρος δεδομένων που θέλετε να χρησιμοποιήσετε, δείτε το στιγμιότυπο οθόνης:

doc μεταφέρει μοναδικές τιμές 7

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

doc μεταφέρει μοναδικές τιμές 8

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

doc μεταφέρει μοναδικές τιμές 9


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

Kutools για Excel : με περισσότερα από 300 εύχρηστα πρόσθετα Excel, δωρεάν δοκιμή χωρίς περιορισμό σε 30 ημέρες.

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

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

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

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

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

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

doc μεταφέρει μοναδικές τιμές 11

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

doc μεταφέρει μοναδικές τιμές 12

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

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

doc μεταφέρει μοναδικές τιμές 14 14

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

doc μεταφέρει μοναδικές τιμές 15

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

doc μεταφέρει μοναδικές τιμές 16

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


Kutools για Excel: με περισσότερα από 300 εύχρηστα πρόσθετα του Excel, δωρεάν δοκιμή χωρίς περιορισμό σε 30 ημέρες. Λήψη και δωρεάν δοκιμή τώρα!

Τα καλύτερα εργαλεία παραγωγικότητας του Office

Το Kutools για Excel λύνει τα περισσότερα από τα προβλήματά σας και αυξάνει την παραγωγικότητά σας κατά 80%

  • Επαναχρησιμοποίηση: Εισαγάγετε γρήγορα σύνθετοι τύποι, γραφήματα και οτιδήποτε έχετε χρησιμοποιήσει στο παρελθόν. Κρυπτογράφηση κυττάρων με κωδικό πρόσβασης Δημιουργία λίστας αλληλογραφίας και στείλτε email ...
  • Super Formula Bar (επεξεργαστείτε εύκολα πολλές γραμμές κειμένου και τύπου). Διάταξη ανάγνωσης (εύκολη ανάγνωση και επεξεργασία μεγάλου αριθμού κελιών). Επικόλληση σε φιλτραρισμένο εύρος...
  • Συγχώνευση κελιών / σειρών / στηλών χωρίς απώλεια δεδομένων · Περιεχόμενο διαχωρισμού κελιών Συνδυάστε διπλές σειρές / στήλες... Αποτροπή διπλών κυττάρων; Συγκρίνετε τα εύρη...
  • Επιλέξτε Διπλότυπο ή Μοναδικό Σειρές; Επιλέξτε Κενές σειρές (όλα τα κελιά είναι κενά). Σούπερ εύρεση και ασαφής εύρεση σε πολλά βιβλία εργασίας. Τυχαία επιλογή ...
  • Ακριβές αντίγραφο Πολλαπλά κελιά χωρίς αλλαγή της αναφοράς τύπου. Αυτόματη δημιουργία αναφορών σε πολλαπλά φύλλα? Εισαγωγή κουκκίδων, Πλαίσια ελέγχου και άλλα ...
  • Εξαγωγή κειμένου, Προσθήκη κειμένου, Κατάργηση κατά θέση, Αφαιρέστε το διάστημα; Δημιουργία και εκτύπωση υποσύνολων σελιδοποίησης. Μετατροπή περιεχομένου και σχολίων μεταξύ κελιών...
  • Σούπερ φίλτρο (αποθηκεύστε και εφαρμόστε σχήματα φίλτρων σε άλλα φύλλα). Προηγμένη ταξινόμηση ανά μήνα / εβδομάδα / ημέρα, συχνότητα και άλλα. Ειδικό φίλτρο με έντονη, πλάγια ...
  • Συνδυάστε βιβλία εργασίας και φύλλα εργασίας; Συγχώνευση πινάκων βάσει βασικών στηλών. Διαχωρίστε τα δεδομένα σε πολλά φύλλα; Μαζική μετατροπή xls, xlsx και PDF...
  • Περισσότερα από 300 ισχυρά χαρακτηριστικά. Υποστηρίζει Office / Excel 2007-2021 και 365. Υποστηρίζει όλες τις γλώσσες. Εύκολη ανάπτυξη στην επιχείρηση ή τον οργανισμό σας. Πλήρεις δυνατότητες δωρεάν δοκιμής 30 ημερών. Εγγύηση επιστροφής χρημάτων 60 ημερών.
kte καρτέλα 201905

Το Office Tab φέρνει τη διεπαφή με καρτέλες στο Office και κάνει την εργασία σας πολύ πιο εύκολη

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
κάτω μέρος γραφείου
Σχόλια (56)
Δεν υπάρχουν ακόμη βαθμολογίες. Γίνε ο πρώτος που θα αξιολογήσετε!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πώς θα πήγαινα προς την αντίθετη κατεύθυνση; Από πολλές στήλες σε μία στήλη; Ευχαριστώ εκ των προτέρων! Τιμ
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αυτό ήταν φανταστικό. Είχα ένα excel με περίπου 2000 μοναδικές τιμές στη σειρά Α και δεν θα μπορούσα να καταφέρω αυτήν την άσκηση χωρίς τη βοήθειά σας. Πολλά πολλά ευχαριστώ.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Το ίδιο το πρώτο βήμα αποτυγχάνει =INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0)) δίνει το σφάλμα Value Not Available
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Απλώς θέλω να κάνω το αντίθετο. Σαν να έχω ήδη το τελικό αποτέλεσμα και θέλω να πετύχω το πρώτο βήμα.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ψάχνω το ίδιο πράγμα
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Βρήκατε κάποια λύση για το αντίθετο σενάριο; Ευχαριστώ!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Θέλω να κάνω και το αντίθετο. Έχετε κάποια λύση κύριοι;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας παιδιά,
Για να λάβετε το αντίθετο αποτέλεσμα με βάση το παράδειγμα αυτού του άρθρου, μπορείτε να εφαρμόσετε τον ακόλουθο κώδικα VBA: (Σημείωση: Όταν επιλέγετε το εύρος δεδομένων που θέλετε να μεταφέρετε, εξαιρέστε τη σειρά κεφαλίδας)

Sub TransposeUnique_2()
Dim xLRow, xLCCount As Long
Dim xRg ως εύρος
Dim xOutRg ως εύρος
Dim xObjRRg ως εύρος
Dim xTxt ως συμβολοσειρά
Dim xCount As Long
Dim xVRg ως εύρος
On Error Συνέχιση Επόμενη
xTxt = ActiveWindow.RangeSelection.Address
Ορισμός xRg = Application.InputBox("παρακαλώ επιλέξτε εύρος δεδομένων:", "Kutools για Excel", xTxt, , , , , 8)
Ορισμός xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
Εάν το xRg δεν είναι τίποτα, τότε βγείτε από το Sub
Εάν (xRg.Rows.count < 2) Ή _
(xRg.Areas.count > 1) Στη συνέχεια
MsgBox "Μη έγκυρη επιλογή", , "Kutools for Excel"
Έξοδος Sub
End If
Ορίστε xOutRg = Application.InputBox("παρακαλώ επιλέξτε εύρος εξόδου(καθορίστε ένα κελί):", "Kutools for Excel", xTxt, , , , , 8)
Εάν το xOutRg δεν είναι τίποτα, τότε βγείτε από το Sub
Application.ScreenUpdating = False
xLCount = xRg.Columns.count
Για xLRow = 1 έως xRg.Rows.count
Ορισμός xObjRRg = Εύρος (xRg.Cells(xLRow, 2), xRg.Cells(xLRow, xLCount)).SpecialCells(xlCellTypeConstants)
xObjRRg.Αντιγραφή
xOutRg.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = Λάθος
Range(Cells(xOutRg.Row, xOutRg.Column), Cells(xOutRg.Row + xObjRRg.count - 1, xOutRg.Column)).Τιμή = xRg.Cells(xLRow, 1).Τιμή
Ορισμός xOutRg = xOutRg.Offset(RowOffset:=xObjRRg.count)
Επόμενο
Application.ScreenUpdating = True
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πώς να κάνετε τη μεταφορά εάν η στήλη Β δεν έχει μοναδικές τιμές αλλά εξακολουθεί να χρειάζεται αυτές τις τιμές
ΚΤΕ 100
ΚΤΕ 100
Υποθέτοντας ότι πρόκειται για δύο διαφορετικές συναλλαγές
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, Ντιντίν,

Μπορείτε να δώσετε το πρόβλημά σας πιο ξεκάθαρα ή αναλυτικά;
Μπορείτε να εισαγάγετε ένα παράδειγμα στιγμιότυπου οθόνης για το πρόβλημά σας.
Ευχαριστώ!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου,
Θα μπορούσατε σας παρακαλώ να με βοηθήσετε με την παρακάτω απαίτηση.
Προϊόν ----- παραγγελία
KTE ------ 100KTE ------ 200KTO ------ 300KTO ------ 300
αναμενόμενη απόδοση
Προϊόν ----- παραγγελία ----- παραγγελία ------ παραγγελία
ΚΤΕ ------ 100 ------ 200
ΚΤΟ ------ 300 ------ 300







Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Κι εγώ το ίδιο χρειάζομαι. Θέλω να εμφανίσω το 100 δύο φορές αν υπάρχει στα δεδομένα
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Μπορείτε να προτείνετε μια φόρμουλα για αυτό
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Λάβατε ποτέ απάντηση/λύση σε αυτήν την πρόκληση; Έχω το ίδιο.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Υπάρχει τρόπος να γίνει αυτό αντίστροφα; Δηλ. δεδομένα σε σειρές διαφορετικού μήκους και έτσι ταξινόμηση σε δύο στήλες; Δείτε το συνημμένο.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Θέλω να μεταφέρω και διπλές τιμές (όλες τις τιμές - μοναδικές + διπλές) και όχι μόνο μοναδικές τιμές. Μπορείτε να δώσετε τον τύπο και για αυτό.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Το ίδιο χρειάζομαι
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Λάβατε ποτέ απάντηση/λύση σε αυτήν την πρόκληση; Έχω το ίδιο.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Με τον παρακάτω τύπο:

=IFERROR(INDEX($B$2:$B$45, MATCH(0, COUNTIF($D2:D2,$B$2:$B$45)+IF($A$2:$A$10<>$D2, 1, 0), 0)), 0)

Πώς μπορώ να μεταφέρω τα δεδομένα χρησιμοποιώντας κατά προσέγγιση αντιστοιχίσεις; Ας πούμε, θέλω να εξαγάγω όλες τις τιμές από τη στήλη Β που ταιριάζουν με τους πρώτους 9 χαρακτήρες / ψηφία από τη στήλη Α; Η στήλη Β έχει 11 χαρακτήρες ενώ η Α μόνο 9. ευχαριστώ!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πρέπει να κάνω ακριβώς το αντίθετο από αυτό. Έχω πολλές πολλές στήλες που σχετίζονται με ένα αναγνωριστικό σειράς και θέλω να τις επικολλήσω σε δύο στήλες
για παράδειγμα έχω
rowid, value, value1, value2, value3, value4, value..225
100, Dolphin, 255, 9--, Sarah, Jameson, ....
179, Router, flood, jason, 89, nose



Θέλω να φαίνεται έτσι
100, Δελφίνι
100, 255
100, 9--
100, Σάρα
100, Τζέιμσον
179, δρομολογητής
179, πλημμύρα
179, Ιάσονας
179, 89
179, μύτη
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου, Ντέιβ,
Για να λύσετε το πρόβλημά σας, χρησιμοποιήστε τον παρακάτω κωδικό VBA: (Σημείωση: Όταν επιλέγετε το εύρος δεδομένων που θέλετε να μεταφέρετε, εξαιρέστε τη σειρά κεφαλίδας.)

Sub TransposeUnique_2()
Dim xLRow, xLCCount As Long
Dim xRg ως εύρος
Dim xOutRg ως εύρος
Dim xObjRRg ως εύρος
Dim xTxt ως συμβολοσειρά
Dim xCount As Long
Dim xVRg ως εύρος
On Error Συνέχιση Επόμενη
xTxt = ActiveWindow.RangeSelection.Address
Ορισμός xRg = Application.InputBox("παρακαλώ επιλέξτε εύρος δεδομένων:", "Kutools για Excel", xTxt, , , , , 8)
Ορισμός xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
Εάν το xRg δεν είναι τίποτα, τότε βγείτε από το Sub
Εάν (xRg.Rows.count < 2) Ή _
(xRg.Areas.count > 1) Στη συνέχεια
MsgBox "Μη έγκυρη επιλογή", , "Kutools for Excel"
Έξοδος Sub
End If
Ορίστε xOutRg = Application.InputBox("παρακαλώ επιλέξτε εύρος εξόδου(καθορίστε ένα κελί):", "Kutools for Excel", xTxt, , , , , 8)
Εάν το xOutRg δεν είναι τίποτα, τότε βγείτε από το Sub
Application.ScreenUpdating = False
xLCount = xRg.Columns.count
Για xLRow = 1 έως xRg.Rows.count
Ορισμός xObjRRg = Εύρος (xRg.Cells(xLRow, 2), xRg.Cells(xLRow, xLCount)).SpecialCells(xlCellTypeConstants)
xObjRRg.Αντιγραφή
xOutRg.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = Λάθος
Range(Cells(xOutRg.Row, xOutRg.Column), Cells(xOutRg.Row + xObjRRg.count - 1, xOutRg.Column)).Τιμή = xRg.Cells(xLRow, 1).Τιμή
Ορισμός xOutRg = xOutRg.Offset(RowOffset:=xObjRRg.count)
Επόμενο
Application.ScreenUpdating = True
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ, λειτουργεί άψογα, με γλίτωσες 2 μέρες! :)
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Skyyang,
κοινοποιήστε τον κωδικό για 3 στήλες. Παρακάτω είναι το παράδειγμα:
Θέλω τα δεδομένα όπως: κοινότητα yogesh@gmail.com 1 προβολή μόνο κοινότητα 2 προβολή μόνο ...... κοινότητα goyal@gmail.com 1 προβολή μόνο κοινότητα 2 προβολή μόνο........

Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου ygoyal,

Για να λύσετε το πρόβλημά σας, εφαρμόστε τον παρακάτω κώδικα:

Sub TransposeUnique_2()

Dim xLRow, xLCCount As Long

Dim xRg ως εύρος

Dim xOutRg ως εύρος

Dim xObjRRg ως εύρος

Dim xTxt ως συμβολοσειρά

Dim xCount As Long

Dim xVRg ως εύρος

Dim xC, xI, xI1, xI2 ως ακέραιος αριθμός

On Error Συνέχιση Επόμενη

xTxt = ActiveWindow.RangeSelection.Address

Ορισμός xRg = Application.InputBox("παρακαλώ επιλέξτε εύρος δεδομένων:", "Kutools για Excel", xTxt, , , , , 8)

Ορισμός xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)

Εάν το xRg δεν είναι τίποτα, τότε βγείτε από το Sub

Εάν (xRg.Rows.Count < 2) Ή _

(xRg.Areas.Count > 1) Στη συνέχεια

MsgBox "Μη έγκυρη επιλογή", , "Kutools for Excel"

Έξοδος Sub

End If

Ορίστε xOutRg = Application.InputBox("παρακαλώ επιλέξτε εύρος εξόδου(καθορίστε ένα κελί):", "Kutools for Excel", xTxt, , , , , 8)

Εάν το xOutRg δεν είναι τίποτα, τότε βγείτε από το Sub

Application.ScreenUpdating = False

xLCount = xRg.Columns.Count

Για xLRow = 1 έως xRg.Rows.Count

Ορισμός xObjRRg = Εύρος (xRg.Cells(xLRow, 2), xRg.Cells(xLRow, xLCount)).SpecialCells(xlCellTypeConstants)

On Error Συνέχιση Επόμενη

xC = (xObjRRg.Count Mod 2)

Αν xC <> 0 Τότε

xC = Int(xObjRRg.Count / 2) + 1

Αλλού

xC = Int(xObjRRg.Count / 2)

End If

xI1 = 1

xI2 = 2

Για xI = 1 έως xC

Εύρος(xObjRRg.Item(xI1), xObjRRg.Item(xI2)).Αντιγραφή

xOutRg.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = Λάθος

xOutRg.Value = xRg.Cells(xLRow, 1).Value

Ορισμός xOutRg = xOutRg.Offset(RowOffset:=1)

xI1 = xI1 + (2)

xI2 = xI2 + (2)

Επόμενο

Επόμενο

Application.ScreenUpdating = True

Sub End



Παρακαλώ δοκιμάστε, ελπίζω ότι μπορεί να σας βοηθήσει!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου αδερφέ, ο κώδικας λειτουργεί αντίθετα. Ανατρέξτε στο συνημμένο στιγμιότυπο οθόνης της απαίτησης. Τα διαθέσιμα δεδομένα είναι κατά σειρά και θέλουν να μεταφέρουν τα δεδομένα σε στήλες .
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου ygoyal,
Συγγνώμη για την καθυστερημένη απάντηση, εφαρμόστε τον παρακάτω κώδικα, δοκιμάστε τον!

Sub transposeunique()

«ενημέρωση κατά Extendoffice

Dim xLRow As Long

Dim i As Long

Dim xCrit As String

Dim xCol ως νέα συλλογή

Dim xRg ως εύρος

Dim xOutRg ως εύρος

Dim xTxt ως συμβολοσειρά

Dim xCount As Long

Dim xVRg ως εύρος

Dim xFRg, xSRg, xCRg ως εύρος

On Error Συνέχιση Επόμενη

xTxt = ActiveWindow.RangeSelection.Address

Ορισμός xRg = Application.InputBox("παρακαλώ επιλέξτε εύρος δεδομένων (μόνο 3 στήλες):", "Kutools for Excel", xTxt, , , , , 8)

Ορισμός xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)

Εάν το xRg δεν είναι τίποτα, τότε βγείτε από το Sub

Εάν (xRg.Columns.Count <> 3) Ή _

(xRg.Areas.Count > 1) Στη συνέχεια

MsgBox "η περιοχή που χρησιμοποιείται είναι μόνο μία περιοχή με δύο στήλες ", , "Kutools for Excel"

Έξοδος Sub

End If

Ορίστε xOutRg = Application.InputBox("παρακαλώ επιλέξτε εύρος εξόδου(καθορίστε ένα κελί):", "Kutools for Excel", xTxt, , , , , 8)

Εάν το xOutRg δεν είναι τίποτα, τότε βγείτε από το Sub

Ορισμός xOutRg = xOutRg.Range(1)

xLRow = xRg.Rows.Count

Για i = 2 Σε xLRow

xCol.Add xRg.Cells(i, 1).Value, xRg.Cells(i, 1).Value

Επόμενο

Application.ScreenUpdating = False

Application.ScreenUpdating = False

Για i = 1 Προς xCol.Count

xCrit = xCol.Item(i)

xOutRg.Offset(i, 0) = xCrit

xRg.AutoFilter Field:=1, Criteria1:=xCrit

Ορισμός xVRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)

Αν xVRg.Count > xCount Τότε xCount = xVRg.Count

Ορισμός xSRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)

Ορισμός xCRg = xOutRg.Offset(i, 1)

Για κάθε xFRg Σε xSRg

xFRg.Αντιγραφή

xCRg.PasteSpecial

xRg.Range("B1").Αντιγραφή

xCRg.Offset(-(i), 0).PasteSpecial

xFRg.Offset(0, 1).Αντιγραφή

Ορισμός xCRg = xCRg.Offset(0, 1)

xCRg.PasteSpecial

xRg.Range("c1").Αντιγραφή

xCRg.Offset(-(i), 0).PasteSpecial

Ορισμός xCRg = xCRg.Offset(0, 1)

Επόμενο

Application.CutCopyMode = Λάθος

Επόμενο

xRg.Item(1).Αντιγραφή

xOutRg.PasteSpecial

xRg.AutoFilter

Application.ScreenUpdating = True

Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου αδερφέ, προσπάθησα να χρησιμοποιήσω αυτόν τον κωδικό, αλλά το excel κολλάει όταν εκτελώ αυτόν τον κώδικα και δεν μπορούσα να δω την έξοδο από τον παραπάνω κώδικα. παρακαλώ προτείνετε τι να κάνετε σε αυτήν την περίπτωση.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας,
Ο κώδικας λειτουργεί καλά στο βιβλίο εργασίας μου, ποια έκδοση Excel χρησιμοποιείτε;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
MS Excel 2016
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ο κώδικας λειτουργεί καλά και στο Excel 2016 μου, δοκιμάστε τον πρώτα με κάποια δεδομένα μικρού εύρους.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Δοκιμάστηκε σε 160 εγγραφές, αλλά σε αυτό το αντίγραφο υπήρχε ακόμα.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Skyyang, σου αρέσει αυτό, υπάρχει περίπτωση να το κάνεις να λειτουργήσει για τέσσερις στήλες; πάλι απλά χρησιμοποιώντας τις δύο πρώτες ως σύγκριση ή ακόμα καλύτερα τη δυνατότητα επιλογής του αριθμού των στηλών πριν τις επιλέξετε; Έριξα μια ματιά στο σενάριό σου, δεν θα είχα ιδέα για το πώς να το πετύχω...
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Skyyang, σου αρέσει αυτό, υπάρχει περίπτωση να το κάνεις να λειτουργήσει για τέσσερις στήλες; πάλι απλά χρησιμοποιώντας τις δύο πρώτες ως σύγκριση ή ακόμα καλύτερα τη δυνατότητα επιλογής του αριθμού των στηλών πριν τις επιλέξετε; Έριξα μια ματιά στο σενάριό σου, δεν θα είχα ιδέα για το πώς να το πετύχω...
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αδερφέ, βοήθησε σε αυτό.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου αδερφέ, ακόμα περιμένω τη βοήθειά σου
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Όπως και ο Dave, πρέπει να κάνω ακριβώς το αντίθετο από αυτό. Πίνακας 2 για μεταφορά στον Πίνακα 1. Πίνακας εισόδου 2, Πίνακας εξόδου 1.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
=INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0)) λειτούργησε για να μεταφέρω τις μοναδικές τιμές μιας στήλης σε μια νέα στήλη ΑΛΛΑ...υπάρχει τρόπος διαφήμισης σε συνάρτηση ταξινόμησης ώστε η νέα στήλη που δημιουργήθηκε να μεταφερθεί με αύξουσα σειρά;


Ευχαριστώ!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πρέπει να λάβετε την ίδια έξοδο, αλλά για να επιλεγούν προκαθορισμένες στήλες θα ήταν ($A,$B) και θα χρειαστεί η στήλη εξόδου Θέση στο $D$1.
Αν κάποιος έχει ιδέα θα ήταν πολύ καλή!!!!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, μπορούμε να προσθέσουμε κάθε σειρά και να δώσουμε την έξοδο σε μία στήλη, με την παραπάνω λειτουργικότητα.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Λοιπόν εργάζομαι σε μια εταιρεία. Έχουμε στήλες για πληροφορίες όπως Επώνυμο, όνομα, κατάταξη, ενότητα, αριθμός τηλεφώνου, διεύθυνση. Υπάρχει τρόπος να χρησιμοποιήσω έναν παρόμοιο τύπο για να μεταφέρω ολόκληρη τη σειρά πληροφοριών σε μια στήλη με ονόματα;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
=INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0)) λειτούργησε για να μεταφέρω τις μοναδικές τιμές της στήλης A σε μια νέα στήλη BUT...υπάρχει τρόπος να μεταφερθούν όλες οι τιμές στη στήλη B όπως δίνεται παρακάτω:

Ημερομηνία Παραγγελίας Προϊόντος Παραγγελία Παραγγελίας Παραγγελία Παραγγελίας Παραγγελία Παραγγελίας Παραγγελίας
ΚΤΕ 100 3/3/2019 ΚΤΕ 100 100 100 200 100 150 100
ΚΤΟ 150 3/3/2019 ΚΤΟ 150 100 200 100 150 200
ΚΤΕ 100 3/4/2019 ΜΠΟΤ 150 100 200 150 100 200
ΚΤΟ 100 3/4/2019 ΚΩΔ 200 150 100 150
ΚΤΟ 200 3/5/2019
ΚΤΕ 100 3/5/2019
BOT 150 3/5/2019
BOT 100 3/6/2019
ΚΤΟ 100 3/6/2019
ΚΤΕ 200 3/6/2019
BOT 200 3/7/2019
ΚΩΔ 200 3/7/2019
ΚΤΕ 100 3/7/2019
ΚΤΟ 150 3/7/2019
BOT 150 3/8/2019
ΚΤΕ 150 3/8/2019
ΚΩΔ 150 3/8/2019
BOT 100 3/9/2019
BOT 200 3/10/2019
ΚΩΔ 100 3/10/2019
ΚΤΟ 200 3/10/2019
ΚΩΔ 150 3/11/2019
ΚΤΕ 100 3/11/2019
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Η μακροεντολή δεν λειτούργησε. Μόλις αντέγραψε τα περιεχόμενα στο κελί A1.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Έχω ένα σύνολο δεδομένων στις Στήλες Α (Μοναδικό αναγνωριστικό) - Ε. Κάθε σειρά έχει δεδομένα με βάση το ID#, υπάρχουν πολλές σειρές για κάθε ID#, αλλά θέλω μια σειρά ανά ID# με όλα τα άλλα δεδομένα σε στήλες ( θα ήταν 5 στήλες ελάχιστο και 25 μέγιστο, ανάλογα με το πόσες έχει κάθε μοναδικό αναγνωριστικό). Βρήκα έναν κωδικό αλλά λειτουργεί μόνο για δύο στήλες. Έπρεπε να συνδέσω τις τέσσερις στήλες (χωρίς το αναγνωριστικό) και μετά να οριοθετήσω μετά την εκτέλεση της μακροεντολής (πολλή δουλειά). Για 15,000 σειρές δεδομένων αυτό είναι επιπλέον χρονοβόρο. Υπάρχει μια μακροεντολή ατελείωτων στηλών που θα λειτουργούσε; Ευχαριστώ εκ των προτέρων όλους για τη βοήθειά σας!
ID ΚΩΔΙΚΟΣ ST ΚΩΔΙΚΟΣ# ΗΜΕΡΟΜΗΝΙΑ
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Έχω ένα σύνολο δεδομένων που έχει πολλαπλά αναγνωριστικά στη στήλη Α και έχει συνδεδεμένα δεδομένα στη στήλη Β. Χρησιμοποίησα τον παραπάνω τύπο και τον άλλαξα λίγο έτσι ώστε να μεταφέρω τα κελιά της στήλης Β σε μια σειρά με βάση το μοναδικό αναγνωριστικό συνδέεται με αυτό στη στήλη Α. Ο τύπος που χρησιμοποιείται για τον προσδιορισμό των μοναδικών αναγνωριστικών είναι: =INDEX($A$2:$A$13409, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$13409), 0)). Ο τύπος που χρησιμοποιείται για τη μεταφορά είναι: =IFERROR(INDEX($B$2:$B$13409, MATCH(0, IF($A$2:$A$13409<>$D2, 1, 0)+COUNTIF($D2: D2,$B$2:$B$13409), 0)), "Δ/Υ"). Και τα δύο δίνονται στο άρθρο, μόνο ελαφρώς αλλαγμένα.

Το πρόβλημα είναι ότι το σύνολο δεδομένων μου στη στήλη Β έχει διπλότυπα, που μερικές φορές εμφανίζονται το ένα μετά το άλλο και χρειάζομαι όλες τις τιμές στη στήλη να παρουσιάζονται στις σειρές.

Η συνημμένη εικόνα είναι αυτό που θα ήθελα να δείχνει ο πίνακας (αυτό είναι ένα μικρό μέγεθος δείγματος, το πραγματικό σύνολο δεδομένων έχει πάνω από 13,000 καταχωρήσεις). Αυτό που συμβαίνει τώρα είναι ότι όταν συναντηθεί μια τιμή επανάληψης, δεν θα την μετρήσει.
π.χ. Η σειρά 9 για το αναγνωριστικό 11980 δείχνει τώρα μόνο 0 -31.79 -0.19 -0.74 N/AN/A .... όταν αυτό που χρειάζομαι για εμφάνιση είναι 0 0 -31.79 -0.19 -0.74 0 0 N/AN/A . ...

Υπάρχει τρόπος να επιλύσετε αυτό το ζήτημα και να το επιλύσετε;

Σας ευχαριστούμε εκ των προτέρων!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Λάβατε ποτέ απάντηση/λύση σε αυτήν την πρόκληση; Έχω το ίδιο.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Έχω ένα σύνολο δεδομένων που έχει 3 στήλες που παρουσιάζονται παρακάτω:



Στήλη Α Στήλη Β Στήλη Γ



Χώρα1 Έτος1 Αξία1

Χώρα1 Έτος2 Αξία2

Χώρα 1 Έτος3 Αξία3,



Χώρα2 Έτος1 Αξία1

Χώρα 2 Έτος3 Αξία3,

...........



Πρέπει να συνδυάσω αυτές τις 3 στήλες σε έναν πίνακα όπως αυτός:

Έτος1 Έτος2 Έτος3 ................................. ΈτοςΧ



Country1 Value1 Value2 Value3

Country2 Value1 #Missing Value3

.....
.....
.....

CountryX Valuex .....................





Το πρόβλημα που αντιμετωπίζω είναι ότι για ορισμένα δεδομένα στη στήλη Α δεν έχω τιμές για κάθε έτος μόνο για ορισμένα. (Για παράδειγμα, η χώρα 2 έχει τιμές που λείπουν για το Έτος 2)





Υπάρχει τρόπος να επιλύσετε αυτό το ζήτημα και να το επιλύσετε;



Σας ευχαριστούμε εκ των προτέρων!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
μπορείτε να μοιραστείτε τον κωδικό εάν υπάρχουν 2 στήλες που πρέπει να αντιγραφούν αντί για 1. παρακάτω είναι το παράδειγμα.
Δεν υπάρχουν σχόλια δημοσιεύτηκε ακόμα
Τοποθετήστε Περισσότερα
Αφήστε τα σχόλιά σας
Δημοσίευση ως επισκέπτης
×
Αξιολογήστε αυτήν την ανάρτηση:
0   Χαρακτήρες
Προτεινόμενες τοποθεσίες

Ακολουθησε μας

Πνευματικά δικαιώματα © 2009 - www.extendoffice.com. | Ολα τα δικαιώματα διατηρούνται. Τροφοδοτείται από ExtendOffice. | Sitemap
Το Microsoft και το λογότυπο του Office είναι εμπορικά σήματα ή σήματα κατατεθέντα της Microsoft Corporation στις Ηνωμένες Πολιτείες ή / και σε άλλες χώρες.
Προστατεύεται από το Sectigo SSL