Πώς να μεταφέρετε διπλές σειρές σε στήλες στο Excel;
Ας υποθέσουμε ότι έχετε μια σειρά δεδομένων στο Excel, τώρα, θα θέλατε να μεταφέρετε τις διπλές σειρές σε πολλές στήλες όπως φαίνεται στο παρακάτω στιγμιότυπο οθόνης, έχετε καλές ιδέες για την επίλυση αυτής της εργασίας;
Μεταφέρετε διπλές σειρές σε στήλες με κώδικα VBA
Μεταφέρετε διπλές σειρές σε στήλες με κώδικα VBA
Δυστυχώς, δεν υπάρχει άμεσος τρόπος για να το αντιμετωπίσετε στο Excel, αλλά μπορείτε να δημιουργήσετε έναν κώδικα VBA για να το λύσετε, κάντε τα εξής:
1. Κρατήστε πατημένο το ALT + F11 για να ανοίξετε το Παράθυρο Microsoft Visual Basic for Applications.
2. Κλίκ Κύριο θέμα > Μονάδα μέτρησηςκαι επικολλήστε τον ακόλουθο κώδικα στο Παράθυρο ενότητας.
Κωδικός VBA: Μεταφέρετε διπλές σειρές σε πολλές στήλες
Sub ConvertTable()
'Updateby Extendoffice
Dim xArr1 As Variant
Dim xArr2 As Variant
Dim InputRng As Range, OutRng As Range
Dim xRows As Long
xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Set OutRng = OutRng.Range("A1")
xArr1 = InputRng.Value
t = UBound(xArr1, 2): xRows = 1
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 2 To UBound(xArr1, 1)
If Not .exists(xArr1(i, 1)) Then
xRows = xRows + 1: .Item(xArr1(i, 1)) = VBA.Array(xRows, t)
For ii = 1 To t
xArr1(xRows, ii) = xArr1(i, ii)
Next
Else
xArr2 = .Item(xArr1(i, 1))
If UBound(xArr1, 2) < xArr2(1) + t - 1 Then
ReDim Preserve xArr1(1 To UBound(xArr1, 1), 1 To xArr2(1) + t - 1)
For ii = 2 To t
xArr1(1, xArr2(1) + ii - 1) = xArr1(1, ii)
Next
End If
For ii = 2 To t
xArr1(xArr2(0), xArr2(1) + ii - 1) = xArr1(i, ii)
Next
xArr2(1) = xArr2(1) + t - 1: .Item(xArr1(i, 1)) = xArr2
End If
Next
End With
OutRng.Resize(xRows, UBound(xArr1, 2)).Value = xArr1
End Sub
3. Στη συνέχεια πατήστε F5 για να εκτελέσετε αυτόν τον κώδικα, επιλέξτε το εύρος δεδομένων που θέλετε να μετατρέψετε τις διπλές σειρές σε πολλές στήλες στο αναδυόμενο παράθυρο διαλόγου, δείτε το στιγμιότυπο οθόνης:
4. Κλίκ OKκαι επιλέξτε ένα κελί όπου θέλετε να βάλετε το αποτέλεσμα στο ακόλουθο παράθυρο διαλόγου, δείτε το στιγμιότυπο οθόνης:
5. Και στη συνέχεια κάντε κλικ στο κουμπί OK κουμπί, τα επιλεγμένα δεδομένα σας έχουν μετατραπεί ως εξής:
Σχετικά Άρθρα:
Πώς να μεταφέρετε / μετατρέψετε στήλες και σειρές σε μία σειρά;
Πώς να μεταφέρετε / μετατρέψετε στήλες και σειρές σε μία στήλη;
Πώς να μεταφέρετε / μετατρέψετε μία στήλη σε πολλές στήλες στο Excel;
Τα καλύτερα εργαλεία παραγωγικότητας γραφείου
Αυξήστε τις δεξιότητές σας στο Excel με τα Kutools για Excel και απολαύστε την αποτελεσματικότητα όπως ποτέ πριν. Το Kutools για Excel προσφέρει πάνω από 300 προηγμένες δυνατότητες για την ενίσχυση της παραγωγικότητας και την εξοικονόμηση χρόνου. Κάντε κλικ εδώ για να αποκτήσετε τη δυνατότητα που χρειάζεστε περισσότερο...
Το Office Tab φέρνει τη διεπαφή με καρτέλες στο Office και κάνει την εργασία σας πολύ πιο εύκολη
- Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
- Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
- Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
