Μετάβαση στο κύριο περιεχόμενο

Πώς να εξαγάγετε κείμενο βάσει χρώματος γραμματοσειράς από ένα κελί στο Excel;

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

doc-extract-text-color-1

Εξαγωγή κειμένου με βάση το χρώμα της γραμματοσειράς από κάθε κελί


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

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

1. Τύπος Alt + F11 για να ανοίξετε το παράθυρο της Microsoft Visual Basic for Applications.

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

VBA: Εξαγωγή κειμένου με βάση το χρώμα της γραμματοσειράς

Function GetColorText(pRange As Range) As String
'UpdatebyExtendoffice20220621
Dim xOut As String
Dim xValue As String
Dim i As Long
Dim TextColor
TextColor = RGB(255, 0, 0) 'colorindex RGB
xValue = pRange.Text
For i = 1 To VBA.Len(xValue)
  If pRange.Characters(i, 1).Font.Color = TextColor Then
  xOut = xOut & VBA.Mid(xValue, i, 1)
  End If
Next
GetColorText = xOut
End Function

3. Στη συνέχεια, αποθηκεύστε και κλείστε το παράθυρο διαλόγου και επιλέξτε ένα κενό κελί δίπλα στη λίστα δεδομένων, πληκτρολογήστε αυτόν τον τύπο = GetColorText (A1) (Το Α1 υποδεικνύει το κελί από το οποίο θέλετε να εξαγάγετε κείμενο), πατήστε εισάγετε για να λάβετε το απαραίτητο κείμενο και, στη συνέχεια, σύρετε τη λαβή αυτόματης συμπλήρωσης για να συμπληρώσετε τον τύπο στο εύρος που θέλετε.

Τώρα μπορείτε να δείτε ότι εξάγεται όλο το κόκκινο κείμενο.

doc-extract-text-color-2

Άκρο: Στον παραπάνω κώδικα VBA, μπορείτε να αλλάξετε το χρώμα rgb σε αυτό το σενάριο TextColor = RGB(255, 0, 0) σε άλλα για να καλύψετε τις ανάγκες σας.


Σχετικά άρθρα:

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

Δημοφιλή χαρακτηριστικά: Εύρεση, επισήμανση ή αναγνώριση διπλότυπων   |  Διαγραφή κενών γραμμών   |  Συνδυάστε στήλες ή κελιά χωρίς απώλεια δεδομένων   |   Γύρος χωρίς φόρμουλα ...
Σούπερ Αναζήτηση: VLookup πολλαπλών κριτηρίων    VLookup πολλαπλών τιμών  |   VLookup σε πολλά φύλλα   |   Ασαφής αναζήτηση ....
Σύνθετη αναπτυσσόμενη λίστα: Γρήγορη δημιουργία αναπτυσσόμενης λίστας   |  Εξαρτημένη αναπτυσσόμενη λίστα   |  Πολλαπλή αναπτυσσόμενη λίστα ....
Διαχειριστής στήλης: Προσθέστε έναν συγκεκριμένο αριθμό στηλών  |  Μετακίνηση στηλών  |  Εναλλαγή κατάστασης ορατότητας κρυφών στηλών  |  Συγκρίνετε εύρη και στήλες ...
Επιλεγμένα Χαρακτηριστικά: Εστίαση πλέγματος   |  Προβολή σχεδίου   |   Μεγάλη Formula Bar    Διαχείριση βιβλίου εργασίας & φύλλου   |  Βιβλιοθήκη πόρων (Αυτόματο κείμενο)   |  Επιλογή ημερομηνίας   |  Συνδυάστε φύλλα εργασίας   |  Κρυπτογράφηση/Αποκρυπτογράφηση κελιών    Αποστολή email ανά λίστα   |  Σούπερ φίλτρο   |   Ειδικό φίλτρο (φίλτρο με έντονη γραφή/πλάγια γραφή/διαγραφή...) ...
Κορυφαία 15 σύνολα εργαλείων12 Κείμενο Εργαλεία (Προσθήκη κειμένου, Κατάργηση χαρακτήρων, ...)   |   50 + Διάγραμμα Τύποι (Gantt διάγραμμα, ...)   |   40+ Πρακτικό ΜΑΘΗΜΑΤΙΚΟΙ τυποι (Υπολογίστε την ηλικία με βάση τα γενέθλια, ...)   |   19 Εισαγωγή Εργαλεία (Εισαγωγή κωδικού QR, Εισαγωγή εικόνας από το μονοπάτι, ...)   |   12 Μετατροπή Εργαλεία (Αριθμοί σε λέξεις, Μετατροπή Συναλλάγματος, ...)   |   7 Συγχώνευση & διαχωρισμός Εργαλεία (Σύνθετες σειρές συνδυασμού, Διαίρεση κελιών, ...)   |   ... κι αλλα

Αυξήστε τις δεξιότητές σας στο Excel με τα Kutools για Excel και απολαύστε την αποτελεσματικότητα όπως ποτέ πριν. Το Kutools για Excel προσφέρει πάνω από 300 προηγμένες δυνατότητες για την ενίσχυση της παραγωγικότητας και την εξοικονόμηση χρόνου.  Κάντε κλικ εδώ για να αποκτήσετε τη δυνατότητα που χρειάζεστε περισσότερο...

kte καρτέλα 201905


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

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
Comments (14)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
I have a particular text in a cell seperated by Comma and Having colour for each text. While using Delimiter funtion,I am unable to retain the font colour of text .Appraciate your help!
This comment was minimized by the moderator on the site
Hi, jdhjjd, I do not understand your question clearly. Do you want to extract the specific text from cells and keep its font color as below screenshot shown?
https://www.extendoffice.com/images/stories/comments/sun-comment/split_and_keep_font_color.png
or split cells and keep each text font color?
https://www.extendoffice.com/images/stories/comments/sun-comment/split_and_keep_font_color-2.png
This comment was minimized by the moderator on the site
I was still unable to extract the blue text (#1166BB). Is there a way to use the Hex: #1166BB to get the color text I need?
This comment was minimized by the moderator on the site
Hi, Robert E Perez, I have updated the VBA code, now, it supports to get colored text by rgb code. You can try the code again.
This comment was minimized by the moderator on the site
The code works well if the red strings are continuous. In case they are separated in the source cell, they are glued to each other in output cell. I mean there is no space in the output if the red text strings are away from each other. Can you please provide a solution for this?
This comment was minimized by the moderator on the site
Try this, it should work
Function GetColorText(pRange As Range) As String
'Updatedtogetmultiple
Dim xOut As String
Dim xValue As String
Dim i As Long
Dim wasRed As Boolean
xValue = pRange.Text

For i = 1 To VBA.Len(xValue)

If pRange.Characters(i, 1).Font.Color = vbRed Then
xOut = xOut & VBA.Mid(xValue, i, 1)
wasRed = True
ElseIf wasRed = True Then
wasRed = False
xOut = xOut & ";"
End If

Next

GetColorText = xOut
End Function

This comment was minimized by the moderator on the site
Thanks a ton it worked perfectly well. You are a savior Tim :-) 
This comment was minimized by the moderator on the site
thanks, very interesting code.
This comment was minimized by the moderator on the site
dimenticavo io ho Excel 2010
This comment was minimized by the moderator on the site
Buonasera, grazie mille un'ottima funzione. Però ho un problema, quando val nel foglio ed inserisco es. = GetColorText (A1) mi restituisce il valore giusto però come riavvio il file mi da errore #VALORE!, se poi clicco 2 volte sopra mi da il valore corretto e così via. che posso fare?
This comment was minimized by the moderator on the site
Hey, Thanks for the Tip. Works great with Red and Black.
What if I want to parse "Purple"? changing it vbPurple does not work.
Thanks
This comment was minimized by the moderator on the site
The code works well if the red strings are continuous. In case they are separated in the source cell, they are glued to each other in output cell. I mean there is no space in the output if the red text strings are away from each other. Can you please provide a solution for this?
This comment was minimized by the moderator on the site
Hello, when i tried using vbBlue, it did not work. Help please? Thanks!
This comment was minimized by the moderator on the site
Give the font color to the exct blue color.
Because there are many type of blue color "light blue, sky blue, dark blue"
vba match only exct color.??????
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations