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

Πώς να τολμήσετε όλες τις συγκεκριμένες λέξεις σε μια σειρά κελιών;

Έγγραφο έντονο κείμενο 1

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

Έντονη γραφή όλων των συγκεκριμένων λέξεων σε μια σειρά κελιών με κώδικα VBA


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

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

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

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

Κωδικός VBA: Έντονο κείμενο σε μια σειρά κελιών

Sub FindAndBold()
'Updateby Extendoffice 20160711
    Dim xFind As String
    Dim xCell As Range
    Dim xTxtRg As Range
    Dim xCount As Long
    Dim xLen As Integer
    Dim xStart As Integer
    Dim xRg As Range
    Dim xTxt As String
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
    Set xRg = Application.InputBox("Please select data range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    On Error Resume Next
    Set xTxtRg = Application.Intersect(xRg.SpecialCells(xlCellTypeConstants, xlTextValues), xRg)
    If xTxtRg Is Nothing Then
        MsgBox "There are no cells with text"
        Exit Sub
    End If
    xFind = Trim(Application.InputBox("What do you want to BOLD?", "Kutools for Excel", , , , , , 2))
    If xFind = "" Then
        MsgBox "No text was listed", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    xLen = Len(xFind)
    For Each xCell In xTxtRg
        xStart = InStr(xCell.Value, xFind)
        Do While xStart > 0
            xCell.Characters(xStart, xLen).Font.Bold = True
            xCount = xCount + 1
            xStart = InStr(xStart + xLen, xCell.Value, xFind)
        Loop
    Next
    If xCount > 0 Then
        MsgBox "number of " & CStr(xCount) & " text be bolded!", vbInformation, "Kutools for Excel"
    Else
        MsgBox "Not find the specific text!", vbInformation, "Kutools for Excel"
    End If
End Sub

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

Έγγραφο έντονο κείμενο 2

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

Έγγραφο έντονο κείμενο 3

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

Έγγραφο έντονο κείμενο 4

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

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

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

Περιγραφή


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

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
Comments (10)
Rated 5 out of 5 · 1 ratings
This comment was minimized by the moderator on the site
Worked perfectly fine for me. I track leases and the documents that need to be submitted by agents. I put "none" in the cells for the leases that have had all docs turned in. Bolding the words makes it easier to read!

Thanks again for the help!
Rated 5 out of 5
This comment was minimized by the moderator on the site
Awesome! Worked great!
This comment was minimized by the moderator on the site
I get the first pop up hit ok but then don't get the second pop up window to type in the word?
This comment was minimized by the moderator on the site
I attempted to run this code and just got an error..."Compile Error: Wrong # of arguments or invalid property assignment". Below is the image of the error message and the breakpoint of the code.
This comment was minimized by the moderator on the site
Hello, Sherry,
I can not see your screenshot, please upload it again.
Thank you!
This comment was minimized by the moderator on the site
Hello, its possible to search multiple text and bold that text PLUS that cell line. (I have 1 cell with 5 lines, i want to bold the line if find "1º", if rest like "2º" "3º" , "number + º " bold only number.)

Other need is:
If find "1º" bold that cell line
This comment was minimized by the moderator on the site
Can this VBA be modified to bold multiple texts, such as "KTE", "KTO", and "KTW"?
This comment was minimized by the moderator on the site
Hello, Eric,

May be the following VBA code can help you to bold multiple specific cell, please apply the below code.
Sub FindAndBold()
Dim I As Long
Dim xFind As String
Dim xCell As Range
Dim xTxtRg As Range
Dim xCount As Long
Dim xLen As Integer
Dim xStart As Integer
Dim xRg As Range, xRgFind As Range
Dim xTxt As String
Dim xArr() As String
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("Please select data range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
On Error Resume Next
Set xTxtRg = Application.Intersect(xRg.SpecialCells(xlCellTypeConstants, xlTextValues), xRg)
If xTxtRg Is Nothing Then
MsgBox "There are no cells with text"
Exit Sub
End If
Set xRgFind = Application.InputBox("Select the text cells you want to bold", "Kutools for Excel", , , , , , 8)
If xRgFind Is Nothing Then
MsgBox "No text was listed", vbInformation, "Kutools for Excel"
Exit Sub
End If
ReDim xArr(xRgFind.Count - 1)
For I = 0 To (xRgFind.Count - 1)
xArr(I) = xRgFind(I + 1)
Next
For Each xCell In xTxtRg
For I = 0 To UBound(xArr)
xFind = Trim(xArr(I))
xStart = InStr(xCell.Value, xFind)
xLen = Len(xFind)
Do While xStart > 0
xCell.Characters(xStart, xLen).Font.Bold = True
xCount = xCount + 1
xStart = InStr(xStart + xLen, xCell.Value, xFind)
Loop
Next
Next
If xCount > 0 Then
MsgBox "number of " & CStr(xCount) & " text be bolded!", vbInformation, "Kutools for Excel"
Else
MsgBox "Not find the specific text!", vbInformation, "Kutools for Excel"
End If
End Sub

Hope it can help you, thank you!
This comment was minimized by the moderator on the site
Hello skyyang, can you help me out in my excel?
If find "1º" in a cell with several lines, bold that cell line
This comment was minimized by the moderator on the site
if I want to make bold the string G-AD only it doesn t work if i have in my cell G-AD and G-AD-bla-bla-bla (this G-AD should not be made BOLD)
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations