Как выделить цветом ячейки в которых встречаются две заглавные буквы [A-Z]?

#excel #excel_формулы

У меня есть листы в Excel в котором часть ячеек содержит пары заглавных букв [A-Z].
Мне нужно выделить все эти ячейки цветом. Как это сделать средствами Excel?

Ну или как включить регулярные выражения в excel?
    

Ответы

Ответ 1

Добавьте условное форматирование по формуле: =СОВПАД(A1;ПРОПИСН(ЛЕВСИМВ(A1;2))) т.е.
форматировать те ячейки которые содержат 2 символа и оба строчные



P.S. Изменил немного формулу, добавил условие, что длина строки равна 2, т.к. первое
условие срабатывало и для одной заглавной буквы.

=И(СОВПАД(A1;ПРОПИСН(ЛЕВСИМВ(A1;2)));ДЛСТР(A1)=2)


Ответ 2

Как включить и использовать регулярные выражения в Excel

Получился такой макрос:

Sub fillCell()
    Dim oWkb As Workbook
    Set oWkb = ActiveWorkbook

    Dim oWsh As Worksheet

    Dim SheetsArray
    SheetsArray = Array(1) ' Array("Лист1")

    Dim Cell As Object

    Dim RegExpAZ As New RegExp
    With RegExpAZ
        .pattern = "[А-Я,A-Z]{2}"
    End With

    ' Можно перебирать все листы книги `oWkb.Worksheets`, либо задать их номера или
названия в массиве `SheetsArray` (в данном варианте участвует только первый лист)
    For Each Sheet In SheetsArray ' oWkb.Worksheets
        Set oWsh = oWkb.Worksheets.Item(Sheet) ' Sheet

        ' Указываем диапазон:
        ' Количество строк (либо все строки на странице `oWsh.Rows.Count`)
        For r = 1 To 16 ' oWsh.Rows.Count
            ' Количество столбцов (либо все столбцы на странице `oWsh.Columns.Count`)
            For c = 1 To 8 ' oWsh.Columns.Count
                Set Cell = oWsh.Cells(r, c)
                ' Ищем совпадения по регулярному выражению
                If (Cell <> "") And (RegExpAZ.Test(Cell)) Then
                    ' Выделяем цветом ячейку, соответствующую условию
                    With Cell.Interior
                        .pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 5296274
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                End If
            Next c
        Next r
    Next
End Sub


Результат:


Ответ 3

Вариант для проверки двух первых символов:

=И(СОВПАД(ПСТР(A1;{1;2};1);ПРОПИСН(ПСТР(A1;{1;2};1))))



  Khipster: А как английские A-Z выделять?... можно ли сделать поиск по всем символам,
а не только по первым двум?
  
  Zufir: Без VBA - видимо, никак.


Не обижайте Excel :)
Хоть на листе и проблематично работать с регулярками, но и без них можно.

Формула условного форматирования:

=СЧЁТ(1/(НАЙТИ(ПСТР(A1&ПОВТОР(" ";20);СТРОКА($1:$19);1);"ABCDEFGHIJKLMNOPQRSTUVWXYZ")*НАЙТИ(ПСТР(A1&ПОВТОР("
";20);СТРОКА($2:$20);1);"ABCDEFGHIJKLMNOPQRSTUVWXYZ")))


Не нужно бояться, тут все сравнительно просто.

В формуле два фрагмента, одинаковых по логике работы:

ПСТР(A2&ПОВТОР(" ";20);СТРОКА($1:$19);1)

ПСТР(A2&ПОВТОР(" ";20);СТРОКА($2:$20);1)


Отличие второй ПСТР - из строки последовательно извлекаются символы, начиная со второго.
Т.е. в паре две функции проверяют два соседних символа.

Берем последовательно  каждый символ текста. За это отвечает функция СТРОКА()

Чтобы не определять длину текста, добавляем символы: ПОВТОР(" ";20)

Объединяем по И два значения (здесь правильнее писать - условия):

НАЙТИ(символ1;перечень_символов)*НАЙТИ(символ2;перечень_символов)


ИСТИНА (число), если два символа подряд найдены в перечне символов. При других результатах
- ошибка (одна или две функции НАЙТИ покажут ошибку #ЗНАЧ!)

Итог работы этой части - массив значений и ошибок, например {#ЗНАЧ!:72:#ЗНАЧ!:#ЗНАЧ!}

=СЧЕТ(1/полученный_массив)


Функция игнорирует ошибки, считает только значения - количество пар заглавных букв.
Если формула на листе, нужно добавить условие: *=СЧЕТ(...)>0.

Нужно отметить, что в текстах "TEstER" и "TESter" функция определит по две пары.

Условное форматирование (УФ) само понимает, что любое число, отличное от нуля, ИСТИНА,
поэтому формулу в УФ с нулем можно не сравнивать.


Ответ 4

Без VBA - видимо, никак. В Excel нет регулярок на уровне листов, если ничего не изменилось
в самых последних версиях.
С VBA - https://stackoverflow.com/questions/22542834/how-to-use-regular-expressions-regex-in-microsoft-excel-both-in-cell-and-loops

Из диапазона список значений, расположенных правее ячеек с искомым словом

Утро доброе! Имеется таблица Excel
Красным я отметил ячейку перед важной информацией Справа от красного нужная мне инфа Инфа хаотично разбросана
В ячейке после красной, лежит нужная инфа (на одной строке). Её нужно перенести в пустой столбец. Как вырвать соседнюю ячейку?
Пример

Ответ

В указанном диапазоне ищем слово. Из значений правее ячеек со словом формируем массив. После обработки массив выгружаем на лист
Sub ValueOnTheRight() Dim aRes() Dim rRng As Range, c Dim lCnt As Long, k As Long Const sStr As String = "Industry" Set rRng = Range("C2:K250") lCnt = Application.CountIf(rRng, sStr) ReDim aRes(1 To lCnt, 1 To 1)
For Each c In rRng If c.Value = sStr Then k = k + 1 aRes(k, 1) = c.Offset(, 1).Value End If Next c
Range("L2:L" & k + 1).Value = aRes End Sub
Макрос разместить в общем модуле.
Эту же задачу выполняет формула
=ЕСЛИОШИБКА(ИНДЕКС($A$1:$L$250; НАИМЕНЬШИЙ( ЕСЛИ($C$2:$K$250="Industry";СТРОКА($C$2:$K$250)+СТОЛБЕЦ($C$2:$K$250)*0,001);СТРОКА(A1)); 1+ПРАВБ(НАИМЕНЬШИЙ( ЕСЛИ($C$2:$K$250="Industry";СТРОКА($C$2:$K$250)+СТОЛБЕЦ($C$2:$K$250)*0,001);СТРОКА(A1)); 3));"")
Формула массива. Записать в ячейку, в режиме редактирования нажать Ctrl+Shift+Enter - формула должна заключиться в фигурные скобки. Копировать (протянуть) ячейку вниз.
Недостатки формулы:
требует специального ввода; производит много вычислений, при большом количестве может вызвать подтормаживание при пересчетах; по строкам протягивать нужно с запасом, иначе можно не увидеть последних значений.
' ---------------------
Дополнение. Вывод результата построчно в сответствии с найденными значениями.
Sub ValueOnTheRight2() Dim aRes() Dim rRng As Range, c Dim lCnt As Long Const sStr As String = "Industry" Set rRng = Range("C1:K250"): lCnt = rRng.Rows.Count ReDim aRes(1 To lCnt, 1 To 1)
For Each c In rRng If c.Value = sStr Then aRes(c.Row, 1) = c.Offset(, 1).Value End If Next c
Range("L1:L250").Value = aRes End Sub
Если в одной строке несколько искомых значений, в результат запишется только одно. Для накопления изменить строку записи:
aRes(c.Row, 1) = aRes(c.Row, 1) & " " & c.Offset(, 1).Value