Блог

Как я могу изменить следующие строки кода, чтобы найти строку на листе и выделить строки, если строка содержится в ячейке? Например, строка поиска — «SV-32346r1», а содержимое ячейки — «Документ содержит список автомобилей с идентификатором SV-32346r1 в Кали». эта строка должна быть выделена. Приведенный ниже код выполняет поиск только точных совпадений.

 If InStr(strConcatList, cell.Value) > 0 Then       'InStr returns 0 if the string isn't found
    cell.EntireRow.Interior.Color = RGB(255, 0, 0) 'Highlights the row in red if value found
End If
 

Полный код здесь (спасибо Айкену):

 Public Sub HighlightListedValues()
Dim strConcatList As String
Dim cell As Range

'Creates a string concatenating your list of strings, separated by |s
'e.g. "item1|item2|item3|item4|"
For Each cell In Sheets("List").Range("A1:A40")
strConcatList = strConcatList amp; cell.Value amp; "|"
Next cell

'For each used cell in Column A of sheet1, check whether the value in that cell
'is contained within the concatenated string
For Each cell In Intersect(Sheets("Gap Analysis").Range("E:E"), Sheets("Gap Analysis").UsedRange)
If InStr(strConcatList, cell.Value) > 0 Then       'InStr returns 0 if the string isn't found
    cell.EntireRow.Interior.Color = RGB(255, 0, 0) 'Highlights the row in red if value found
End If
Next cell
End Sub
 

Если вас интересует решение, отличное от VBA, вот как это сделать с помощью условного форматирования. Предполагая, что ваши данные находятся в столбце A, а список кодов находится в C2: C7, вы можете использовать эту формулу условного форматирования:

 =SUM(COUNTIF($A4,"*" amp; $C$2:$C$7 amp; "*"))
 

Настройте его следующим образом:

Обратите внимание, что это позволяет вам использовать несколько кодов, которые, как я предполагаю, могут быть причиной использования VBA.

Вместо того чтобы проверять каждую ячейку на соответствие списку, вам нужно проверить каждый элемент в списке на соответствие ячейке. Один из способов — это использование регулярных выражений. Оказывается, что список с разделителями канала в регулярном выражении выполняет такое сопоставление. В приведенном ниже коде измените «Лист1» на «Список»; и «Лист2» на «Анализ пробелов». Обратите внимание, что я изменил способ компоновки StrConcat таким образом, чтобы в начале или конце списка не было канала, а также чтобы не было «пустых» элементов.

 Option Explicit
Public Sub HighlightListedValues()
Dim strConcatList As String
Dim cell As Range
Dim RE As Object

'Creates a string concatenating your list of strings, separated by |s
'e.g. "item1|item2|item3|item4|"
For Each cell In Sheets("Sheet1").Range("A1:A40")
    If cell.Value <> "" Then strConcatList = strConcatList amp; "|" amp; cell.Value
Next cell
strConcatList = Mid(strConcatList, 2)

Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .ignorecase = True
    .Pattern = strConcatList
End With

'For each used cell in Column A of sheet1, check whether the value in that cell
'is contained within the concatenated string
For Each cell In Intersect(Sheets("sheet2").Range("E:E"), Sheets("sheet2").UsedRange)
If RE.test(cell.Value) = True Then
    cell.EntireRow.Interior.Color = RGB(255, 0, 0) 'Highlights the row in red if value found
Else
    cell.EntireRow.Interior.Color = xlNone
End If
Next cell
End Sub
 

И если вы не хотите возиться с регулярными выражениями, вот способ сделать это с помощью «родного» VBA:

 Option Explicit
Public Sub HighlightListedValues()
Dim strConcatList() As String
Dim cell As Range
Dim I As Long

'Creates an arrary of your list of strings
With Worksheets("Sheet1").Range("A1:A40")
    ReDim strConcatList(1 To WorksheetFunction.CountA(.Value))
    For Each cell In .Cells
        If cell.Value <> "" Then
            I = I   1
            strConcatList(I) = cell.Value
        End If
    Next cell
End With

'For each used cell in Column A of sheet1, check whether the value in that cell
'is contained within the concatenated string
For Each cell In Intersect(Sheets("sheet2").Range("E:E"), Sheets("sheet2").UsedRange)
    For I = 1 To UBound(strConcatList)
        With cell.EntireRow.Interior
        If InStr(1, cell.Value, strConcatList(I), vbTextCompare) > 0 Then
            .Color = vbRed
            Exit For
        Else
            .Color = xlNone
        End If
        End With
    Next I
Next cell
End Sub