- При запуске появляется два окна:
- Ввод буквы столбца, в котором нужно искать (например, A, B, C).
- Ввод ключевого слова или подстроки для поиска (например, женск).
- Все строки, содержащие эту подстроку в указанном столбце, выделяются синим цветом.
1. Открыть редактор макросов — сочетанием Alt + F11
2. Выделить ваш проект левой кнопкой мыши (VBAProject (Ваш проект.xIsx), нажать на нем правой и выбрать: Вставить - Модуль (Insert > Module)
3. В пустом окне нового модуля пишем код:
Код:
Sub HighlightRowsByColumnAndKeyword()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim keyword As String
Dim colLetter As String
Dim colNumber As Long
Set ws = ActiveSheet
' Step 1: Ask user for column letter
colLetter = InputBox("Enter the column letter to search in (e.g., A, B, C):", "Select Column")
If Trim(colLetter) = "" Then
MsgBox "Operation cancelled (no column selected).", vbExclamation
Exit Sub
End If
' Convert column letter to number
On Error Resume Next
colNumber = Range(colLetter & "1").Column
On Error GoTo 0
If colNumber = 0 Then
MsgBox "Invalid column letter: " & colLetter, vbCritical
Exit Sub
End If
' Step 2: Ask user for keyword
keyword = InputBox("Enter the keyword or partial word to highlight (e.g., женск):", "Enter Keyword")
If Trim(keyword) = "" Then
MsgBox "Operation cancelled (no keyword entered).", vbExclamation
Exit Sub
End If
' Step 3: Find the last row in the selected column
lastRow = ws.Cells(ws.Rows.Count, colNumber).End(xlUp).Row
' Optional: clear previous formatting
ws.Range("A2:Z" & lastRow).Interior.ColorIndex = xlNone
' Step 4: Highlight matching rows
For i = 2 To lastRow
If InStr(1, LCase(ws.Cells(i, colNumber).Value), LCase(keyword)) > 0 Then
ws.Rows(i).Interior.Color = RGB(221, 235, 247) ' Light blue
End If
Next i
MsgBox "Rows containing """ & keyword & """ in column " & UCase(colLetter) & " have been highlighted.", vbInformation
End Sub
4. Открыть выполнение макросов — сочетанием Alt + F8
5. Выбираем макрос по названию в окне
6. Жмем "Выполнить" и смотрим результат