ВЫДЕЛЕНИЕ строк массово по ключевому слову с выделением по схожести

admin

Anabolic Gontarski
Команда форума
Администрация
Доверенный
Новичок
Clip2Net Menu_250620163619.jpeg


  • При запуске появляется два окна:
    1. Ввод буквы столбца, в котором нужно искать (например, A, B, C).
    2. Ввод ключевого слова или подстроки для поиска (например, женск).

  • Все строки, содержащие эту подстроку в указанном столбце, выделяются синим цветом.

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. Жмем "Выполнить" и смотрим результат
 
Назад
Сверху