Здравствуйте! Прошу вашей помощи в решении следующей задачи: в Excel из списка ячеек, содержащих по несколько слов в каждой, нужно найти все слова, содержащие часть слова, и скопировать найденные слова в столбец E (каждое слово в новой ячейке).
Sub WordFingByFragment()
Dim arrIn, arrOut, arrS, lngI As Long, lngJ As Long, lngK As Long, strS As String
strS = Range("C2")
arrIn = Range("A1").CurrentRegion.Value
ReDim arrOut(1 To UBound(arrIn, 1), 1 To 1)
For lngI = 2 To UBound(arrIn, 1)
arrS = Split(arrIn(lngI, 1), " ")
For lngK = 0 To UBound(arrS, 1)
If InStr(1, arrS(lngK), strS) > 0 Then
lngJ = lngJ + 1
arrOut(lngJ, 1) = arrS(lngK)
End If
Next lngK
Next lngI
Range("E2").Resize(lngJ, 1) = arrOut
End Sub
Без МАКС. А еще нужно добавить исключение ошибки: =ЕСЛИОШИБКА(СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(A2;" ";ПОВТОР(" ";99));ПОИСК($C$2;ПОДСТАВИТЬ(A2;" ";ПОВТОР(" ";99)))-50;99));"нет такого") А еще формула отслеживает только один фрагмент. А еще формула не поймает второго, третьего слова (трахея застрахованного страхователя)