Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie: micky_miha Profile
| Femeie 23 ani Bucuresti cauta Barbat 23 - 43 ani |
|
Mrrrr
AdMiN
Inregistrat: acum 17 ani
Postari: 2186
|
|
Source:
You can make certain words red, while others remain black, in the same cell.
Enter text to highlight in an Input Box:
Sub HighlightStrings() 'Updateby Extendoffice 20160704 Application.ScreenUpdating = False Dim Rng As Range Dim cFnd As String Dim xTmp As String Dim x As Long Dim m As Long Dim y As Long cFnd = InputBox("Enter the text string to highlight") y = Len(cFnd) For Each Rng In Selection With Rng m = UBound(Split(Rng.Value, cFnd)) If m > 0 Then xTmp = "" For x = 0 To m - 1 xTmp = xTmp & Split(Rng.Value, cFnd)(x) .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3 xTmp = xTmp & cFnd Next End If End With Next Rng Application.ScreenUpdating = True End Sub |
Enter text to highlight in excel cells (Input box to select both fields):
Sub highlight() 'Updateby Extendoffice 20160704 Dim xStr As String Dim xRg As Range Dim xTxt As String Dim xCell As Range Dim xChar As String Dim I As Long Dim J As Long On Error Resume Next If ActiveWindow.RangeSelection.Count > 1 Then xTxt = ActiveWindow.RangeSelection.AddressLocal Else xTxt = ActiveSheet.UsedRange.AddressLocal End If LInput: Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8) If xRg Is Nothing Then Exit Sub If xRg.Areas.Count > 1 Then MsgBox "not support multiple columns" GoTo LInput End If If xRg.Columns.Count <> 2 Then MsgBox "the selected range can only contain two columns " GoTo LInput End If For I = 0 To xRg.Rows.Count - 1 xStr = xRg.Range("B1").Offset(I, 0).Value With xRg.Range("A1").Offset(I, 0) .Font.ColorIndex = 1 For J = 1 To Len(.Text) If Mid(.Text, J, Len(xStr)) = xStr Then .Characters(J, Len(xStr)).Font.ColorIndex = 3 Next End With Next I End Sub |
_______________________________________
|
|
pus acum 6 ani |
|