Поиск и выделение в таблице по нескольким параметрам - VBA
Формулировка задачи:
Ночи доброй!
возник следующий вопрос:
есть таблица(размерность может быть как увеличена, так и уменьшена)
можно ли вывести на экран менюшку в котороый можно будет задавать несколько параметров поиска?
к примеру в таблице надо найти все ячейки в которых встречаются сразу все эти критерии( П, Г, 234, МЗН)
кол-во параметров может варьироваться от 1го до ++
вбивать параметры нужно ручками в специальном окошке(менюшке), (и в любом порядке)
нужные ячейки будут подсвечиваться цветом к примеру "vbGreen"
Решение задачи: «Поиск и выделение в таблице по нескольким параметрам»
textual
Листинг программы
Sub wrkWITHmyCriteries()
Dim mRng As Range, AllCells As Range, currCell As Range
Dim mArr(), currKey, mVAR, i&, j&
Dim dict As Object, SecDict As Object
mArr = Array("aaa", "b#2c2", "345")
Set dict = CreateObject("scripting.dictionary")
dict.comparemode = 1
Set SecDict = CreateObject("scripting.dictionary")
SecDict.comparemode = 1
For i = LBound(mArr) To UBound(mArr)
dict.Add mArr(i), mArr(i)
Next 'i
For Each currKey In dict.Keys
mVAR = dict.Item(currKey)
If IsNumeric(mVAR) Then
mVAR = CDbl(dict.Item(currKey))
End If
With ActiveSheet
Set mRng = .UsedRange
For Each currCell In mRng
If currCell.Value = mVAR Then
If SecDict.exists(mVAR) Then
SecDict.Item(mVAR).Add currCell.Address
Else
SecDict.Add mVAR, New Collection
SecDict.Item(mVAR).Add _
currCell.Address
End If
End If
Next ' currCell
End With 'ActiveSheet
For i = 1 To SecDict.Item(mVAR).count
If AllCells Is Nothing Then
Set AllCells = Range(SecDict.Item(mVAR)(i))
i = 2
End If
Set AllCells = Union(AllCells, _
Range(SecDict.Item(mVAR)(i)))
Next 'i
Next ' currKey
With AllCells
.Interior.ColorIndex = 35
End With
End Sub