Страницы: 1
RSS
Как реализовать отбор синонимичных значений?
 
Здравствуйте. Каким образом можно было бы реализовать отбор синонимичных значений для определённой ячейки, проходя по столбцу-массиву с данными? Файл примера прилагаю. Из него всё станет ясно. Достаточно реализовать это только для суффиксной формы, т. е. когда отличия будут после, а не до базового значения.
 
как вариант массивная
Код
=ИНДЕКС($B$2:$B$16;НАИМЕНЬШИЙ(ЕСЛИ(ЕЧИСЛО(ПОИСК($A$2;$B$2:$B$16));СТРОКА($B$2:$B$16)-1);СТРОКА(C1)))
Лень двигатель прогресса, доказано!!!
 
Уважаемый, а не могли бы Вы приложить файл, где эта формула прописана, потому что у меня что-то не получается её пристроить. :(
 
Ростислав Жистовский, еще макросом вариант
Код
Sub mrshkei()
Dim arr, arr2, i As Long, lr As Long
lr = Cells(Rows.Count, 2).End(xlUp).Row
arr = Range("A2:B" & lr)
ReDim arr2(1 To lr, 1 To 1): k = 1
For i = LBound(arr) To UBound(arr)
    If InStr(arr(i, 2), arr(1, 1)) > 0 Then arr2(k, 1) = arr(i, 2): k = k + 1
Next i
Range("C2").End(xlDown).Clear
Range("C2").Resize(UBound(arr2), 1) = arr2
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
.
Лень двигатель прогресса, доказано!!!
 
Mershik, с макросом вы по господски сделали, коненчо! :) А на сколько сложно реализовать чуть другую тему через макрос? Файл прикладываю. Типа там не одна ячейка, а в зависимости от количества ячеек в столбце аргументов, будет появляться соответствующее количество столбцов с результатами. Заголовки столбцов мне  не важны, главное - результат в нормированной форме. Это было бы более универсальное решение, которое, я думаю, многим было бы полезно.
Изменено: Ростислав Жистовский - 07.04.2021 16:09:51
 
Ростислав Жистовский,
Код
Sub mrshkei()
Dim arr, arr2, i As Long, lr As Long, lrr As Long
lrr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A2:A" & lrr)
lr = Cells(Rows.Count, 2).End(xlUp).Row
arr2 = Range("B2:B" & lr)
For n = LBound(arr) To UBound(arr)
ReDim arr3(1 To lr, 1 To 1): k = 1
    For i = LBound(arr2) To UBound(arr2)
        If InStr(arr2(i, 1), arr(n, 1)) > 0 Then arr3(k, 1) = arr2(i, 1): k = k + 1
    Next i
    Columns(n + 2).Clear
    Cells(1, n + 2) = arr(n, 1)
    Cells(2, n + 2).Resize(UBound(arr3), UBound(arr3, 2) - LBound(arr3) + 1) = arr3
Next n
End Sub

Изменено: Mershik - 07.04.2021 16:21:47
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, а не могли бы вы скинуть файл с кнопкой, как это было сделано ранее. И, конечно, это мелочь, но, если в просматриваемом массиве встречается чистая копия ячейки-аргумента, нельзя ли её игнорировать? Пример результата во вложении. А так, Вы - профи. Respect.
Прошу прощения, изначально, не тот файл приложил, где дважды запринтилось значение "777".
Изменено: Ростислав Жистовский - 07.04.2021 16:41:10
 
Ростислав Жистовский,
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, сэр, а насколько сложно было бы доработать вашу программу к виду, который в очередном файле примера? Т. е. отбор синонимичных значений является промежуточным результатом (который можно не отображать). Главное - результирующий массив, где под каждым значением ячейки-аргумента функции вставляются отобранные синонимичные значения. Например, в алфавитном порядке. Желательно, кончено, чтобы сначала шли значения с числовыми суффиксами, а уже потом  значения с суффиксами, содержащими какие-либо буквы.
P. S. Причём именно с суффиксами, без значений с префиксами. Не знаю, правда, насколько сложно это реализуется на VBA.
Изменено: Ростислав Жистовский - 08.04.2021 12:03:50
 
Ростислав Жистовский, без сортировки
Не бойтесь совершенства. Вам его не достичь.
Страницы: 1
Наверх