Страницы: 1
RSS
Поиск кросс номеров и вывод результата через запятую.
 
Доброго времени суток.
Помогите пожалуйста, в экселе не силен, от слова совсем.Есть задача поиска кросс номеров автомобильных деталей отдного производителя по другому производителю через заводские OE номера.Перерыл весь инет решения не нашел. К примеру есть деталь производителя Jikiu c номером AB21388 по которому я нахожу на странице Jikiu-OE 2 артикула c оригинальными деталями TOYOTA  (4807520010 и 4806820200). Уже по этим номерам я ищу аналоги производителя на странице Febest-OE - в данном случае это одна деталь с артикулом TAB-197. Поскольку искомых значений может быть большое количество необходимо их объединять в ячейку через запятую.Очень надеюсь на вашу помощь, файл для наглядности прикрепил.
 
Дмитрий Никандров, в зависимости от версии Excel могут быть предложены различные решения, но формульные могут быть только в последних версиях Excel.
По вопросам из тем форума, личку не читаю.
 
Никто не хочет помогать. Наверное время неподходящее (праздники). В принципе VBA метод Find не очень сложно.
 
Цитата
Евгений Смирнов написал:
Никто не хочет помогать.
неее, просто все проверяют
Цитата
Дмитрий Никандров написал:
Перерыл весь инет
весь ли перерыл.

На счет Find - ну я б скорее через ADO делал, PowerQuery тоже должно справится, но непонятна методология работы. внесли номер - получили в соседних ячейках результат, или внесли пачку номеров- нажали кнопку обработать? FILTER, UNIC, TEXTJOIN - позволяют в 365 сделать формульное решение.
Изменено: БМВ - 06.01.2022 09:45:48
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал
неее, просто все проверяют
А если не проверяют, а тоже роют. Ведь все перероют, а кто закапывать будет. Надо хоть какой то вариант
Код
Sub enstaralТаб133()
Dim Arr1, Dic1, i&, j&, k&, Col1 As New Collection, Col2 As New Collection, Col3 As New Collection
Arr1 = Worksheets("Лист1").Cells(1).CurrentRegion
    For i = 2 To UBound(Arr1, 1)
        Col1.Add Arr1(i, 1)
    Next i
Set Dic1 = CreateObject("Scripting.Dictionary")
Arr1 = Worksheets("Jikiu-OE").Cells(1).CurrentRegion
    For i = 2 To UBound(Arr1, 1)
        Dic1(i & Arr1(i, 2)) = Arr1(i, 3)
    Next i
On Error Resume Next
    For j = 1 To Col1.Count
    Set Col21 = New Collection: Col2.Add Col21
        For i = 2 To UBound(Arr1, 1)
If Dic1.Exists(i & Col1(j)) Then Col2(j).Add Dic1(i & Col1(j)), CStr(Dic1(i & Col1(j)))
        Next
    Next
Dic1.RemoveAll: Arr1 = Worksheets("Febest-OE").Cells(1).CurrentRegion
    For i = 2 To UBound(Arr1, 1)
        Dic1(i & Arr1(i, 3)) = Arr1(i, 2)
    Next i
For j = 1 To Col1.Count
    For k = 1 To Col2(j).Count
Set Col31 = New Collection: Col3.Add Col31
        For i = 2 To UBound(Arr1, 1)
If Dic1.Exists(i & Col2(j)(k)) Then Col3(j).Add Dic1(i & Col2(j)(k)), CStr(Dic1(i & Col2(j)(k)))
        Next
    Next
Next
On Error GoTo 0: Set Dic1 = Nothing: ReDim Arr1(1 To Col1.Count, 1 To 2)
    For i = 1 To Col1.Count: For j = 1 To Col2(i).Count
If Arr1(i, 1) = "" Then Arr1(i, 1) = Col2(i)(j) Else Arr1(i, 1) = Arr1(i, 1) & ", " & Col2(i)(j)
    Next: Next
    For i = 1 To Col1.Count: For j = 1 To Col3(i).Count
If Arr1(i, 2) = "" Then Arr1(i, 2) = Col3(i)(j) Else Arr1(i, 2) = Arr1(i, 2) & ", " & Col3(i)(j)
    Next: Next
Worksheets("Лист1").Range("B9").Resize(UBound(Arr1), UBound(Arr1, 2)) = Arr1
End Sub

Изменено: Евгений Смирнов - 06.01.2022 10:26:49
 
Power Query
Код
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Column1", type text}, {"JIKIU", type text}, {"OE", type text}, {"Column2", type text}}),
    #"Removed Columns" = Table.RemoveColumns(#"Changed Type",{"Column1", "Column2"}),
    #"Grouped Rows" = Table.Group(#"Removed Columns", {"JIKIU"}, {{"OE", each _, type table}}),
    #"Added Custom" = Table.AddColumn(#"Grouped Rows", "Пользовательская", each Table.Column([OE],"OE")),
    #"Extracted Values" = Table.TransformColumns(#"Added Custom", {"Пользовательская", each Text.Combine(List.Transform(_, Text.From), ","), type text}),
    #"Renamed Columns" = Table.RenameColumns(#"Extracted Values",{{"Пользовательская", "OE артикул"}}),
    #"Removed Columns1" = Table.RemoveColumns(#"Renamed Columns",{"OE"})
in
    #"Removed Columns1"
 
основной код

Скрытый текст
Изменено: ATK - 08.01.2022 21:44:13
 
Спасибо всем огромное за вашу помощь!!! Теперь осталось разобраться во всех предложенных решениях.
Мне не посвященному в эксель, тут без 100 грамм никак))  
 
Цитата
написал:
Перерыл весь инет
А здесь смотрели?
Изменено: gling - 10.01.2022 05:46:07
 
 Да, сцепитьесли пробовал, и данная формула решает половину моей задачи. Но поскольку с эселем не сильно дружу - я не мог найти решения - как по множеству значений в одной ячейке, найти множество других..
 
Можно ещё так
Код
Sub Макрос2()
arr = Worksheets("Результат").Range("A2:C" & Worksheets("Результат").Cells(Rows.Count, 1).End(xlUp).Row)
arr1 = Worksheets("Jikiu-OE").Range("A2:D" & Worksheets("Jikiu-OE").Cells(Rows.Count, 1).End(xlUp).Row)
arr2 = Worksheets("Febest-OE").Range("A2:D" & Worksheets("Febest-OE").Cells(Rows.Count, 1).End(xlUp).Row)
Set dic1 = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
For n = LBound(arr) To UBound(arr)
    For i = LBound(arr1) To UBound(arr1)
        If CStr(arr(n, 1)) = CStr(arr1(i, 2)) Then
            If Not dic1.exists(CStr(arr1(i, 3))) Then
                dic1.Add CStr(arr1(i, 3)), CStr(arr1(i, 3))
                For m = LBound(arr2) To UBound(arr2)
                    If CStr(arr1(i, 3)) = CStr(arr2(m, 3)) Then
                        If Not dic2.exists(CStr(arr2(m, 2))) Then dic2.Add CStr(arr2(m, 2)), CStr(arr2(m, 2))
                    End If
                Next m
            End If
        End If
    Next i
    arr(n, 2) = Join(dic1.keys, "; ")
    arr(n, 3) = Join(dic2.keys, "; ")
    dic1.RemoveAll
    dic2.RemoveAll
Next n
Worksheets("Результат").Range("A2:C" & Worksheets("Результат").Cells(Rows.Count, 1).End(xlUp).Row) = arr
End Sub
Изменено: Msi2102 - 10.01.2022 09:54:32
 
Msi2102 Спасибо огромное вам за  решение моей задачи, оно самое удобное и максимально быстрое. И можно ли  изменить макрос, чтобы он работал как обычный впр, но по всем искомым значениям, и с выгрузкой всех найденных результатов? А то я попробовал внести измененные данные, макрос сработал только по одиночным значениям в столбце B.  Скиньте мне номер карты, отблагодарю за проделанную работу. Прикрепил файл для наглядности что у меня получилось при изменении данных.
 
Цитата
Дмитрий Никандров написал:  чтобы он работал как обычный впр
что Вы имели ввиду? Если Вы хотите сделать из макроса пользовательскую функцию, то при большой базе она скорее всего будет тормозить, поэтому смысла в этом нет. Если Вы хотите, чтобы поиск происходил по каждому вхождению, то макрос я Вам дописал (см. ниже).
И ещё, я бы на Вашем месте разбил данные на листе Jikiu-OE, то есть, чтобы данные в столбце Jikiu могли иметь повторения, но в столбце OE было по одному значению, а не через точку с запятой.
И ещё не знаю уровень Ваших познаний в EXCEL, а то мог бы ещё посоветовать использовать Power Query для этих целей.
Цитата
Дмитрий Никандров написал: Скиньте мне номер карты, отблагодарю за проделанную работу
Это бесплатная ветка, поэтому достаточно просто человеческого спасибо.
Код
Sub Макрос3()
Dim i As Long, n As Long, m As Long, j As Long, jikiu As Variant, arr As Variant, arr1 As Variant, arr2 As Variant
arr = Worksheets("Результат").Range("A2:C" & Worksheets("Результат").Cells(Rows.Count, 1).End(xlUp).Row)
arr1 = Worksheets("Jikiu-OE").Range("A2:D" & Worksheets("Jikiu-OE").Cells(Rows.Count, 1).End(xlUp).Row)
arr2 = Worksheets("Febest-OE").Range("A2:D" & Worksheets("Febest-OE").Cells(Rows.Count, 1).End(xlUp).Row)
Set dic1 = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
For n = LBound(arr) To UBound(arr)
    For i = LBound(arr1) To UBound(arr1)
        If CStr(arr(n, 1)) = CStr(arr1(i, 2)) Then
            If Not dic1.exists(CStr(arr1(i, 3))) Then
                dic1.Add CStr(arr1(i, 3)), CStr(arr1(i, 3))
                For m = LBound(arr2) To UBound(arr2)
                jikiu = Split(arr1(i, 3), ";")
                    For j = LBound(jikiu) To UBound(jikiu)
                        If CStr(Trim(jikiu(j))) = CStr(arr2(m, 3)) Then
                            If Not dic2.exists(CStr(arr2(m, 2))) Then dic2.Add CStr(arr2(m, 2)), CStr(arr2(m, 2))
                        End If
                     Next j
                Next m
            End If
        End If
    Next i
    arr(n, 2) = Join(dic1.keys, "; ")
    arr(n, 3) = Join(dic2.keys, "; ")
    dic1.RemoveAll
    dic2.RemoveAll
Next n
Worksheets("Результат").Range("A2:C" & Worksheets("Результат").Cells(Rows.Count, 1).End(xlUp).Row) = arr
End Sub
Вот вариант PQ. Я не большой знаток PQ, поэтому возможно, кто-то напишет более быстрый вариант.
Код
let
    fn=(x)=>Excel.CurrentWorkbook(){[Name=x]}[Content],
    is_j = fn("Jikiu_OE")[[JIKIU],[OE]],
    razv_j = Table.ExpandListColumn(Table.TransformColumns(is_j, {{"OE", Splitter.SplitTextByDelimiter("; ", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "OE"),
    tip_j = Table.TransformColumnTypes(razv_j,{{"OE", type text}, {"JIKIU", type text}}),
    is_f = fn("Febest_OE")[[Febest],[OE]],
    ob_jf = Table.NestedJoin(tip_j,{"OE"},is_f,{"OE"},"Febest_OE",JoinKind.LeftOuter),
    rask = Table.ExpandTableColumn(ob_jf, "Febest_OE", {"Febest"}, {"Febest"}),
    is_r = fn("Таблица6"),
    ind_r = Table.AddIndexColumn(is_r, "Индекс", 1, 1),
    tip_r = Table.TransformColumnTypes(ind_r,{{"JIKIU", type text}}),
    ob_rjf = Table.NestedJoin(tip_r,{"JIKIU"},rask,{"JIKIU"},"Jikiu_OE",JoinKind.LeftOuter),
    raz = Table.ExpandTableColumn(ob_rjf, "Jikiu_OE", {"OE", "Febest"}, {"OE", "Febest"}),
    gr = Table.Group(raz, {"JIKIU"}, {{"Количество", each _, type table}}),
    izv_o = Table.TransformColumns(Table.AddColumn(gr, "OE", each Table.Column([Количество], "OE")), {"OE", each Text.Combine(List.Transform(List.Distinct(_), Text.From), "; "), type text}),
    izv_f = Table.TransformColumns(Table.AddColumn(izv_o, "Febest", each Table.Column([Количество], "Febest")), {"Febest", each Text.Combine(List.Transform(List.Distinct(_), Text.From), "; "), type text}),
    izv_i = Table.TransformColumns(Table.AddColumn(izv_f, "Индекс", each Table.Column([Количество], "Индекс")), {"Индекс", each List.First(_, Text.From), Int64.Type}),
    sort = Table.Sort(izv_i,{{"Индекс", Order.Ascending}}),
    udal = Table.SelectColumns(sort,{"OE", "Febest"})
in
    udal

PS: разделителем данных на листе Jikiu-OE в в столбце OE должна служить точка с запятой. На листе Febest-OE в столбце OE не должно присутствовать перечислений (через точку запятой или просто запятая и т.п.)
 
Msi2102 Огромное вам спасибо, для моей задачи вашего макроса достоточно. Так же выражаю большую благодарность остальным форумчанам, кто принимал участие и не оставил меня без внимания.
Страницы: 1
Наверх