Выделенный текст vba excel

@Jack BeNimble
thanks for the code, used it successfully in 10 mins to highlight all the numbers in a cell. I reorganized it a tad, searching all search terms within a row and cell first and allowed for multiple columns. I found one error, your highlight text didn’t like repeats 55, 444, only highlighted the odd repeats in a sequence. Modified one line in Highlight Function

newOffset = offSet + foundPos + Len(searchString) - 1 //added the - 1.

here is my modified code.

Sub NumberColors()

Dim searchTerms As Variant


searchTerms = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".")


Dim searchString As String
Dim targetString As String
Dim offSet As Integer
Dim colsToSearch As Variant
Dim arrayPos, colIndex, colNum As Integer
Dim rowNum As Integer

colsToSearch = Array(4, 44, 45)


For colIndex = LBound(colsToSearch) To UBound(colsToSearch)
    colNum = colsToSearch(colIndex)
    For rowNum = 5 To 3000
        For arrayPos = LBound(searchTerms) To UBound(searchTerms)
            searchString = Trim(searchTerms(arrayPos))

            offSet = 1

            Dim x As Integer

            targetString = Cells(rowNum, colNum).Value

            x = HilightString(offSet, searchString, rowNum, colNum)
        Next arrayPos
    Next rowNum
Next colIndex

End Sub

Function HilightString(offSet As Integer, searchString As String, rowNum As Integer, ingredCol As Integer) As Integer

        Dim x As Integer
        Dim newOffset As Integer
        Dim targetString As String


        ' offet starts at 1

        targetString = Mid(Cells(rowNum, ingredCol), offSet)

        foundPos = InStr(LCase(targetString), searchString)

        If foundPos > 0 Then

            ' the found position will cause a highlight where it was found in the cell starting at the offset - 1
            Cells(rowNum, ingredCol).Characters(offSet + foundPos - 1, Len(searchString)).Font.Color = vbBlue

            ' increment the offset to found position + 1 + the length of the search string
            newOffset = offSet + foundPos + Len(searchString) - 1

            x = HilightString(newOffset, searchString, rowNum, ingredCol)
        Else
            ' if it's not found, come back out of the recursive call stack
            Exit Function
        End If

End Function

Thanks Jack BeNimbleand datatoo

в книге на листе есть ComboBox_Art и TextBox_pcs  
В ComboBox_Art пользователь выбирает/вводит артикул  
В TextBox_pcs вводи значение товара  

    Переход с поля на поле осуществляется по Enter  

  после того как пользователь выбрал товар и количество  
по интеру обробатываеться процедура  

  Private Sub TextBox_pcs_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)  

  If KeyCode = 13 Then  
   If Range(«A19»).Value > 0 And TextBox_pcs.Text > 0 Then  
       Cells(Range(«A18»).Value, 7).Value = Cells(Range(«A18»).Value, 7).Value + TextBox_pcs.Text ‘записываем в базу.  
   CheckBox_hide_Click  

     End If  
   ComboBox_Art.Activate  
End If  

    End Sub  

  Записывается значение в базу и опять активируется ComboBox_Art    
Нужно что бы текст в ComboBox_Art выделился что бы если пользователь начнет вводить новый артикул то не нужно было удалять старый. (выделеный текст при вводе нового стираться)  

  это все нужно что бы оператор смог быстро очень быстро набивать позиции.

Как выделить определенный текст в ячейке на основе другого текста?

В Excel нам может быть легко выделить ячейки на основе определенного текста, но здесь я хочу выделить определенный текст в ячейке, чтобы сделать его выдающимся, но не всю ячейку. Для большинства из нас это, возможно, неприятно. В этой статье я расскажу о некоторых хитростях для решения этой задачи в Excel.

Выделите один или несколько конкретных текстов в нескольких ячейках с кодом VBA

Например, у меня есть ряд текстовых строк, и теперь я хочу выделить конкретный текст «Небо”В этих ячейках, чтобы получить результат, как показано на следующих снимках экрана:

Чтобы выделить только часть текста в ячейке, вам может помочь следующий код VBA.

1. Выберите ячейки, в которых вы хотите выделить конкретный текст, а затем удерживайте ALT + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > Модулии вставьте следующий код в Модули Окно.

Код VBA: выделите часть текста в ячейке:

Sub HighlightStrings()
'Updateby Extendoffice
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

3, Затем нажмите F5 нажмите клавишу для запуска этого кода, и появится окно подсказки, напоминающее вам ввести текст, который вы хотите только выделить, см. снимок экрана:

4, Затем нажмите OK , весь указанный вами текст был выделен только внутри ячеек, см. снимок экрана:

Sub HighlightStrings()
'Updateby Extendoffice
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
Dim xFNum As Integer
Dim xArrFnd As Variant
Dim xStr As String
cFnd = InputBox("Please enter the text, separate them by comma:")
If Len(cFnd) < 1 Then Exit Sub
xArrFnd = Split(cFnd, ",")
For Each Rng In Selection
With Rng
For xFNum = 0 To UBound(xArrFnd)
xStr = xArrFnd(xFNum)
y = Len(xStr)
m = UBound(Split(Rng.Value, xStr))
If m > 0 Then
xTmp = ""
For x = 0 To m - 1
xTmp = xTmp & Split(Rng.Value, xStr)(x)
.Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
xTmp = xTmp & xStr
Next
End If
Next xFNum
End With
Next Rng
Application.ScreenUpdating = True
End Sub

Внимание: Приведенные выше коды чувствительны к регистру.

Выделите один или несколько конкретных текстов в нескольких ячейках с помощью удивительной функции

Если вы не знакомы с кодом в Excel, здесь я представлю простой инструмент — Kutools for Excel, С его Отметить ключевое слово вы можете выделить одно или несколько ключевых слов сразу в ячейках.

Примечание:Чтобы применить эти Отметить ключевое слово функции, во-первых, вы должны скачать Kutools for Excel, а затем быстро и легко примените функции.

После установки Kutools for Excel, пожалуйста, сделайте следующее:

1. Нажмите Кутулс > Текст > Отметить ключевое слово, см. снимок экрана:

2. В Отметить ключевое слово диалоговом окне выполните следующие действия:

• Выберите диапазон данных, который вы хотите использовать, из Диапазон текстовое окно;
• Выберите ячейки, содержащие ключевые слова, которые вы хотите выделить, вы также можете ввести ключевые слова вручную (через запятую) в поле Ключевое слово текстовое поле.
• Наконец, вы должны указать цвет шрифта для выделения текста галочкой Отметить цвета ключевых слов вариант. (Чтобы раскрасить все ячейки, содержащие ключевые слова, выберите Отметьте цвета содержимого ячейки опция)

3, Затем нажмите Ok кнопки, все указанные тексты были выделены, как показано ниже:

Внимание: Эта функция не чувствительна к регистру, если вы хотите выделить текст с учетом регистра, установите флажок С учетом регистра в Отметить ключевое слово диалоговое окно.

Выделите определенный текст в ячейке на основе другого текста с помощью кода VBA

Вот еще одна ситуация, у меня есть два столбца, первый столбец которых содержит текстовые строки, а второй столбец — это конкретный текст, теперь мне нужно выделить относительный текст в первом столбце на основе определенного текста во втором столбце для каждого ряд.

1. Удерживайте ALT + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > Модулии вставьте следующий код в Модули Окно.

Код VBA: выделение части текста в ячейке на основе другого текста:

Sub highlight()
'Updateby Extendoffice
    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

3. После вставки кода нажмите F5 нажмите кнопку для его запуска, появится окно подсказки, напоминающее вам о выборе диапазона данных, который содержит текстовую строку и конкретный текст, который вы хотите выделить и на основе которого, см. снимок экрана:

4, Затем нажмите OK , весь соответствующий текст в первом столбце, основанный на конкретном тексте во втором столбце, был окрашен в красный цвет, как показано на следующем снимке экрана:

Больше относительных статей:

Есть похожий вопрос на английском: Highlighting searched words on Vba excel

Единственная разница, в том вопросе ищется одно слово.

Адаптируем код из этого вопроса, выделим его в процедуру, вынесем все искомые значения в массив и будем вызывать процедуру в цикле:

'Выделяет заданный текст в заданном диапазоне
'Адаптирован код из ответа на Stack Overflow: https://stackoverflow.com/questions/35437207/highlighting-searched-words-on-vba-excel
Sub HighlighText(rng As Range, text As String)
    Application.ScreenUpdating = False
    Dim cellRange As Range
    'Ищем текст на листе
    Set cellRange = rng.Find(What:=text, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    If Not cellRange Is Nothing Then
        Dim cellAddress As String
        cellAddress = cellRange.Address
        Do
            Dim textStart As Integer
            textStart = 1
            Do
                'Ищем текст внутри ячейки
                'Если требуется поиск нечувствительный к регистру, то можно привести и искомое значение и текст к нижнему регистру
                'textStart = InStr(textStart, LCase(cellRange.Value), LCase(text))
                textStart = InStr(textStart, cellRange.Value, text)
                If textStart <> 0 Then
                    'Выделяем текст
                    cellRange.Characters(textStart, Len(text)).Font.Color = RGB(255, 0, 0)
                    textStart = textStart + 1
                End If
            'Выделяем текст пока он находится в этой ячейке
            Loop Until textStart = 0
            Set cellRange = rng.FindNext(After:=cellRange)
        Loop Until cellRange Is Nothing Or cellRange.Address = cellAddress
    End If
End Sub

Sub FindAndSelect()
    'Массив слов (терминов) для выделения
    Dim termsToHighlight As Variant
    termsToHighlight = Array("teams", "TechnicalSuit", "Captivate", "Subscription", "Creative Cloud", "renewal", "TLP", "Stock", "Dreamweave", "CLP", _
                    "Spark", "FrameMaker", "Premiere Pro", "Illustrator", "Fresco", "InCopy", "enterprise", "Audition", "InDesign", "Flash", "Dimension", _
                    "Lightroom", "Substance", "After Effects", "Photoshop", "XD", "Animate", "Presenter", "RoboHelp")
    Dim workRange As Range
    Set workRange = ActiveWorkbook.Worksheets("TDSheet").Range("A1:A3000")
    For Each term In termsToHighlight
        HighlighText workRange, CStr(term)
    Next term
End Sub

Если нужно выделять слова вне зависимости от регистра («Teams», «xd» и др.), то можно исправить функцию поиска текста, читайте комментарии.

И наоборот, если нужно искать слова именно с таким регистром, то можно проставить MatchCase:=True.

В принципе список терминов для выделения можно хранить не в коде, а где-нибудь в самой книге Excel.