Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сопоставление по частичному совпадению и формирование списка
 
#1
02.11.2022 09:32:32
Здравствуйте! Помогите, пожалуйста, решить задачу.
Есть список (1), в ячейках одного из столбцов которого даны перечни видов продукции списком, в рамках каждой из ячеек.
Есть также построчный перечень видов продукции (2), где наименования несколько различаются со списком (1).
Нужно найти совпания, сопоставив построчный перечень видов продукции (2) с каждой из ячеек списка (1). И вывести результат в отдельном столбце списка (1) в виде списка совпадений из перечня (2) в рамках каждой ячейки.
Пример прилагаю.
Буду очень благодарен за помощь!
Изменено: Andrey_Ulrich - 02.11.2022 09:46:23
 
 
 
#2
02.11.2022 11:50:45
Вот вариант макросом
Код
Sub Макрос1()
    Dim arr1, arr2, arr3, arr4, arr5, arr6, n As Long, m As Long, i As Integer, j As Integer
    arr1 = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    arr2 = Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row)
    arr3 = Array(".", ",", "?", "!") ' символы которые должны быть удалены
    arr5 = Array("ая", "ой", "ей", "ий", "ый", "а", "и", "е", "у", "я", "ы") ' окончания которые должны быть удалены
    ReDim arr4(1 To UBound(arr1), 1 To 1)
    Set regex = CreateObject("VBScript.RegExp")
    regex.IgnoreCase = True
    For n = 2 To UBound(arr1)
        For m = 2 To UBound(arr2)
            pat = arr2(m, 1)
            For i = 0 To UBound(arr3)
                pat = Replace(pat, arr3(i), "")
            Next i
            arr6 = Split(pat, " ")
            For i = 0 To UBound(arr6)
                For j = 0 To UBound(arr5)
                    If Right(arr6(i), Len(arr5(j))) = arr5(j) Then arr6(i) = Left(arr6(i), Len(arr6(i)) - Len(arr5(j)))
                Next j
            Next i
            regex.Pattern = Join(arr6, "|")
            If regex.Test(arr1(n, 1)) Then rez = rez & Chr(10) & arr2(m, 1)
        Next m
        arr4(n, 1) = Mid(rez, 2)
        rez = ""
    Next n
    Range("E1:E" & Cells(Rows.Count, 1).End(xlUp).Row) = arr4
End Sub
Изменено: Msi2102 - 02.11.2022 11:52:38
 
 
 
#3
02.11.2022 13:06:56
Msi2102, спасибо большое!
А что значит: n As Long, m As Long, i As Integer, j As Integer ?
Когда я в искомые значения подставляю свой полный перечень, то макрос ругается и дебаг указывает на If regex.Test(arr1(n, 1)) Then
Изменено: Andrey_Ulrich - 02.11.2022 13:07:42
 
 
 
#4
02.11.2022 13:23:40
Цитата
Andrey_Ulrich: А что значит
объявление переменных
Цитата
Andrey_Ulrich: макрос ругается и дебаг указывает на If regex.Test(arr1(n, 1))
добавьте сверху и снизу по строке, чтобы получилось
Код
On Error Resume Next
If regex.Test(arr1(n, 1)) Then rez = rez & Chr(10) & arr2(m, 1)
On Error GoTo 0
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#5
02.11.2022 13:38:58
Jack Famous, спасибо! Это помогло избавиться от ошибки.
Извините, похоже, что я ввел в заблуждение своим изначальным примером. Код комрада Msi2102 правильный, а мой пример - нет...
В результате макрос подтягивает не совсем то, что мне нужно... В пример 19 подставил реальные искомые значения.
Изменено: Andrey_Ulrich - 29.12.2022 16:52:28
 
 
 
#6
02.11.2022 13:46:31
Andrey_Ulrich, Возможно в какой-то ячейке есть что-то наподобие #Н/Д или #ЗНАЧ!
Трудно назвать, причину не видя базы, сделайте как советует Jack Famous, в 4 сообщении или попробуйте так (должен будет выскочить на ошибке)
Код
Sub Макрос1()
    Dim arr1, arr2, arr3, arr4, arr5, arr6, n As Long, m As Long, i As Integer, j As Integer
    On Error GoTo errrr
    arr1 = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    arr2 = Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row)
    arr3 = Array(".", ",", "?", "!") ' символы которые должны быть удалены
    arr5 = Array("ая", "ой", "ей", "ий", "ие", "ый", "а", "и", "е", "у", "я", "ы") ' окончания которые должны быть удалены
    ReDim arr4(1 To UBound(arr1), 1 To 1)
    Set regex = CreateObject("VBScript.RegExp")
    regex.IgnoreCase = True
    For n = 2 To UBound(arr1)
        For m = 2 To UBound(arr2)
            pat = arr2(m, 1)
            For i = 0 To UBound(arr3)
                pat = Replace(pat, arr3(i), "")
            Next i
            arr6 = Split(pat, " ")
            For i = 0 To UBound(arr6)
                For j = 0 To UBound(arr5)
                    If Right(arr6(i), Len(arr5(j))) = arr5(j) Then arr6(i) = Left(arr6(i), Len(arr6(i)) - Len(arr5(j)))
                Next j
            Next i
            regex.Pattern = Join(arr6, "|")
            If regex.Test(arr1(n, 1)) Then rez = rez & Chr(10) & arr2(m, 1)
        Next m
        arr4(n, 1) = Mid(rez, 2)
        rez = ""
    Next n
    Range("E1:E" & Cells(Rows.Count, 1).End(xlUp).Row) = arr4
    Exit Sub
errrr:
    MsgBox "Возможно ошибка в ячейке: " & Cells(n, 1).Address
    Cells(n, 1).Select
End Sub
 
 
 
#7
02.11.2022 13:57:54
Msi2102, с этим справились. Я в пятом посте описал новую проблему...
 
 
 
#8
02.11.2022 14:11:46
Вообще-то, новые вводные из #5 координально меняют принцип обработки, может кто-то подскажет как лучше сделать, у меня сейчас на это нет времени
 
 
 
#9
02.11.2022 14:15:43
Msi2102, я это понял. Извиняюсь, что отнял время. Спасибо за помощь :)
 
 
 
#10
02.11.2022 14:26:51
Чтобы было меньше ошибок, замените строку
Код
    arr3 = Array(".", ",", "?", "!") ' символы которые должны быть удалены

на
Код
    arr3 = Array(".", ",", "?", "!", "-", "_", "<", ">", "\", "/", "*", "+", "=", "(", ")") ' символы которые должны быть удалены

Но опять же это не решит Вашей проблемы
 
 
 
#11
02.11.2022 14:41:28
Цитата
Msi2102: Возможно в какой-то ячейке есть что-то наподобие #Н/Д или #ЗНАЧ!
Сергей, привет! К сожалению, проверки IsError() в данном случае, может быть недостаточно. Сталкивался с тем, что RE.Test() выдаёт ошибку и на "безошибочных" ячейках. Поэтому только пропуск и восстановление.
Можно разнести эти команды перед и после цикла, но вообще они очень шустрые, так что можно и так оставить…
Изменено: Jack Famous - 02.11.2022 14:41:47
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#12
02.11.2022 15:06:07
Цитата
Jack Famous написал:
К сожалению, проверки IsError()
я его вообще не использовал, постарался исключить все служебные символы (см. сообщении №10) в паттерне, для примера закомментировал твои правки (их конечно нужно будет потом раскомментировать), чтобы было видно что ошибка ушла (но лучше конечно, чтобы эти ошибки где-то фиксировались). Просто к этим символам нужно либо добавлять "\", либо удалять их. В самом первом примере было примерно понятно, как это решается эта задача, а с последующими изменениями условий нужно думать, будет недостаточно просто удалить служебные символы, придется некоторые оставлять (например "a.s." должно быть "a\.s\."), да и критерий отбора нужно определить, например сколько слов должно совпасть, сейчас этим критерием является совпадение хотя бы одного слова, но я так понимаю это не должно быть так.
PS: эти рассуждения для ТС, Jack Famous, и так всё знает  :D
Изменено: Msi2102 - 02.11.2022 15:07:30
 
 
 
#13
02.11.2022 15:23:10
Цитата
написал:
PS: эти рассуждения для ТС,  Jack Famous , и так всё знает  
Я это понимаю. У меня проблема серьезнее. Я ничего не понимаю) Точнее, понимаю что-то немного и этого явно хватает знаний для решения проблемы :)
 
 
 
Страницы: 1
Наверх