Страницы: 1
RSS
В тексте поиск слова и изменение его цвета
 
Здравствуйте!
Подскажите пожалуйста такую ситуацию.
В столбце (допусти A) есть ёмкий текст (а мне нужно выделить пару букв-слов)
и мне, как в word`е (т.е. не всю ячейку, а именно выбранное) нужно выделить это слово (буквы)
Конечно можно добавить несколько столбцов, с фукцией ПОИСК
и перебором все это разукрасить.
Вопрос - вероятно ли сделать все это без дополнительных столбцов
сразу в форме или ячейке набрать несколько букв,
которые бы выделились по всему тексту?
Прямого решения не нужно - хотя-бы намек (направление)
 
Цитата
Catboyun написал: хотя-бы намек
Макросом. Включите макрорекордер - В строке редактирования выделите (например жирным или красным цветом) нужное слово/символ - Остановите запись. В редакторе VBE посмотрите полученный код
Согласие есть продукт при полном непротивлении сторон
 
Sanja, спасибо, я умею пользовать рекордером, о чем и говорил
Цитата
Конечно можно добавить несколько столбцов, с фукцией ПОИСК
и перебором все это разукрасить.
т.е. нашлось первое слово, с определенным кол-вом символов - разукрасили, нашлось второе и т.п.
перешли к следующей ячейке.
просто хотелось так:
например есть куча текста в ячейках столбца,
а нам нужно выделить соот к примеру из:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1") Is Nothing Then
......................................................
    End If
End Sub
на счет рекордера, вот мои первые попытки, извиняюсь, если что (то что сразу не приложил)
Изменено: Catboyun - 10.05.2015 22:36:16
 
Решения не существует (или намека)?
Извиняюсь за назойливость.
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c
Dim lRws As Long
Dim sText As String
Dim lLenText As Long
Dim lFind As Long
    If Not Intersect(Target, Range("E1")) Is Nothing Then
        Application.ScreenUpdating = False
        
        lRws = Cells(Rows.Count, 1).End(xlUp).Row ' последняя строка
        sText = Target.Value ' искомое
        lLenText = Len(sText) ' длина искомого
        Range("A1:A" & lRws).Font.ColorIndex = 0
        
        For Each c In Range("A1:A" & lRws)
            If c.Value <> Replace(c.Value, sText, "") Then ' если искомое есть в тексте
                lFind = WorksheetFunction.Find(sText, c.Value) ' позиция искомого
                c.Characters(Start:=lFind, Length:=lLenText).Font.ColorIndex = 3
            End If
        Next c

        Application.ScreenUpdating = True
    End If
End Sub
 
Спасибо, постараюсь изучить.
 
Посмотрите, — может, это подойдёт:
http://excelvba.ru/code/HighlightText
 
Игорь, спасибо, тоже поизучаю.
 
Посмотрите тут: http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=63683&TITLE_SEO=63683-vydelen...
 
Казанский, и Вам спасибо.
 
vikttur
А если в ячейке будет два или три слова заяц?
У меня такой вариант.Макрос в модуль листа1
Код
Sub iText()
Dim i As Long
Dim iLR As Long
Dim re As Object
Dim objMatches As Object
Dim objMatch As Object
  iLR = Cells(Rows.Count, 1).End(xlUp).Row
      Columns("A:A").Font.ColorIndex = 0
  For i = 1 To iLR
      Set re = CreateObject("VBScript.RegExp")
         re.Global = True
         re.IgnoreCase = True
         re.Pattern = Range("E1")
        Set objMatches = re.Execute(Cells(i, 1))
          If objMatches.Count <> 0 Then
             For j = 0 To objMatches.Count - 1
                Set objMatch = objMatches.Item(j)
                With Cells(i, 1).Characters(Start:=objMatch.FirstIndex + 1, Length:=objMatch.Length).Font
                    .ColorIndex = 3
                End With
             Next
          End If
        Set re = Nothing
    Next
End Sub
 
Да, иногда за двумя зайцами гоняться полезно :)
Страницы: 1
Наверх