Всем привет. Есть массив запрещенных символов. Нужно проверить каждую строку из столбца "А" на наличие такого символа. Результат выводить сам символ в ()
Я пробовал через =поиск, пробовал разъединять весь текст по каждой букве, но все не помогает..
!!!ВНИМАНИЕ !!! Макрос ЗАМЕНИТ в выделенном диапазоне данные на символы из списка, если они есть Работает в том числе с отдельными диапазонами, выделенными через Ctrl Если найдено несколько одинаковых символов из списка в одной строке, то выводит только один (уникальный список совпадений) Выводит сообщение с результатами
Инструкция для примера: 1. Скопировать диапазон "A2:A11" в "B2" ("то есть в "B2:B11") 2. Выделить диапазон "B2:B11" 2. Нажать кнопку
Option Explicit
'===========================================================================================
Sub ПроверитьНаличие()
Dim dicList As New Dictionary, dicFind As New Dictionary, rng As Range, ar As Range
Dim x, arr, arrSym, arrOne(1 To 1, 1 To 1)
Dim txt$, AC&, nS&, nC&, r&, c&, t!
t = Timer
Set rng = Selection
arrSym = ActiveSheet.Range("F2:N13")
If Not IsArray(arrSym) Then arrSym = Array(arrSym)
For Each x In arrSym
r = Len(x)
If r > 0 Then x = dicList(Mid$(x, 2, r - 2))
Next x
If dicList.Count = 0 Then Exit Sub
Application.ScreenUpdating = False
AC = Application.Calculation
Application.Calculation = xlCalculationManual
For Each ar In rng.Areas
arr = ar.Value2
If Not IsArray(arr) Then arrOne(1, 1) = arr: arr = arrOne
For c = 1 To UBound(arr, 2)
For r = 1 To UBound(arr, 1)
For Each x In dicList.Keys
If InStr(arr(r, c), x) Then
nS = nS + 1
x = dicFind("(" & x & ")")
End If
Next x
If dicFind.Count > 0 Then
nC = nC + 1
arr(r, c) = Join(dicFind.Keys, "")
dicFind.RemoveAll
Else
arr(r, c) = Empty
End If
Next r
Next c
ar.Value2 = arr
Next ar
Application.ScreenUpdating = True
Application.Calculation = AC
If nC = 0 Then MsgBox "Символов из списка не найдено…", vbInformation, Format$(Timer - t, "0.00 сек"): Exit Sub
MsgBox "Найдено " & nS & " символов в " & nC & " ячейках", vbInformation, Format$(Timer - t, "0.00 сек")
End Sub
'===========================================================================================
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄