Dynami c Поиск нескольких значений в ячейке (через запятую) и возврат соответствующего идентификатора в одну ячейку (также через запятую) - PullRequest
0 голосов
/ 26 мая 2020

Дело в том, что не всегда количество значений (идентификаторов) будет одинаковым в каждой ячейке (как минимум 1, максимум = несколько), поэтому фиксированная версия использования объединенного vlookup + left / mid / right не будет работать для мне из-за этого решение будет работать только до 3 значений. Единственный фиксированный размер - это размер значений для поиска (идентификаторы - зеленым), 8 символов (буквы + цифры).

Я не уверен, но можно ли настроить al oop в пределах формулы / функции Excel? Ниже представлена ​​таблица, содержащая пример проблемы, которую я пытаюсь решить, и ожидаемые значения (таблицы находятся на другой вкладке). Надеюсь, ты сможешь помочь. Спасибо.

примеры-таблицы enter image description here

Ответы [ 3 ]

1 голос
/ 26 мая 2020

Если у вас есть windows Excel O365 с функциями TEXTJOIN и FILTERXML, вы можете использовать формулу:

=TEXTJOIN(",",TRUE,IFERROR(XLOOKUP(FILTERXML("<t><s>" & SUBSTITUTE(@[IDs],",","</s><s>") & "</s></t>","//s"),Table2[IDs],Table2[IDv2]),"""--"""))

Обратите внимание, что в ваших данных есть два идентификатора в A4, не совпадающие ни с одним идентификатором в таблице 2. Хотя это может быть опечатка, я оставил их как есть, чтобы продемонстрировать обработку ошибок.

Table1 enter image description here

Таблица2

enter image description here

0 голосов
/ 26 мая 2020

Попробуйте следующее:

Option Explicit

    Sub Cell2List()
        Dim wF As WorksheetFunction: Set wF = Application.WorksheetFunction 'To user Transpose
        Dim i As Range
        Dim j As Range
        Dim s As String: s = "," 'The separator of the list

        'Ask the user for the cell where are the list with the commas
        'Just need to select the cell
        Set i = Application.InputBox("Select just one cell where the values are", "01. Selecte the values", , , , , , 8)

        'Ask the for the separator. If you are completely sure the comma will never change just delete this line
        s = Application.InputBox("Tell me, what is the character separator, just one character! (optional)", "02. Separator (comma semicolon colon or any other char)", , , , , , 2)
        If s = "" Then s = "," 'Verifying...........

        'Ask the user where want to put the list
        'You need to get ready the cells to receive the list.
        'If there any data will be lost, the macro will overwrite anything in the cells
        Set j = Application.InputBox("Select just one cell where the values will go as a list, just one cell!", "03. Selecte the cell", , , , , , 8)

        Dim myArr: myArr = (Split(i.Value, s)) 'Split the list into a Array


        Range(Cells(j.Row, j.Column), Cells(j.Row + UBound(myArr), j.Column)).Value = wF.Transpose(myArr)
        'j.Row is the row of the cell the user selected to put the cell
        'j.Column the same, but the column
        'j.Row + UBound(myArr) =      UBound(myArr) is the total count of elements in the list
        '                            +j.Row
        '                            _______________
        '                            the last cell of the new list!
        'wF.Transpose(myArr) = we need to "flip" the array... Don't worry, but Don't change it!
    End Sub

Вы можете поместить этот макрос с помощью кнопки на ленте или использовать его, как вы можете видеть на гифке

enter image description here

И вот результат: (с большим списком)

enter image description here

EDIT

Вы можете использовать этот UDF:

Function Cells2List(List As Range, Pos As Integer) As String
    Cells2List = Split(List, ",")(Pos - 1)
End Function

Просто нужно определить и проиндексировать следующим образом:

enter image description here

Чтобы сообщить функции, какой индекс вы хотите видеть. Вы можете использовать эту функцию, используя ROW()-#, чтобы определить 1 в начале, а когда формула отправляет #VALUE!, удалите формулы. Где $A$1 - это список, а D7 - индекс.

0 голосов
/ 26 мая 2020

Вот UDF, который будет делать то, что вы описываете. Вставьте код в стандартный модуль кода (не тот, который уже существует в книге, а тот, который вы создаете и который будет иметь имя типа Module1, прежде чем вы измените его на то, что вам больше всего нравится. Вы также можете переименовать функцию, чтобы дать ей более подходящее имя.

Function ID_v2(Cell As Range) As String
    ' 035

    Dim Fun         As String           ' function return value
    Dim Sp()        As String           ' array of CSVs of CellVal
    Dim VLRng       As Range            ' the lookup range
    Dim VL          As Variant          ' result of VLookup
    Dim i           As Integer          ' loop counter

    ' this is a range similar to your sample A10:D19
    Set VLRng = ThisWorkbook.Names("Table2").RefersToRange
    Sp = Split(Cell.Cells(1).Value, ",")
    If UBound(Sp) >= 0 Then
        For i = 0 To UBound(Sp)
            On Error Resume Next
            VL = Application.VLookup(Trim(Sp(i)), VLRng, 3, False)
            If Err Then VL = "[ERROR]"
            Fun = Fun & VL & ","
        Next i
        ID_v2 = Left(Fun, Len(Fun) - 1)      ' remove final comma
    End If
End Function

Вызов функции с синтаксисом, подобным встроенным функциям. Например,

= ID_v2(A3)

Это можно скопировать, как любую другую функцию. Но не забудьте сохранить книгу как с поддержкой макросов.

...