Используя скрипт-словарь для поиска значений, затем напечатайте ключ

Question

Итак, с помощью других после того, как я задал несколько вопросов, я сейчас нахожусь в точке, где у меня есть нижеприведенный скрипт VBA для макроса. Он ссылается на основной список кодов клиентов и их группы (рабочий лист "CustomerCodeReference"). Предполагается сравнить значения в извлеченном отчете (в столбце "ReportNumber"), найти коды клиентов, перечисленные в этом столбце, и вернуть декодированное имя в следующем доступном пустом столбце.

Итак, на данный момент, если столбец "ReportNumber" содержит номера отчетов:

"A20312345678901, A20212345678901" предполагается сравнить код клиента (первые 4 символа числа, в приведенном выше случае это "A203, A202"), найти их на листе "CustomerCodeReference", а затем вернуть имя группы, к которой относится в пустом столбце (в данном случае "B Team, A Team")

Однако проблема в том, что в данный момент это просто возврат запятых, если есть несколько значений, или ничего, если в ячейке только один номер отчета. (Таким образом, "A20312345678901, A20212345678901" вернет одиночное "," в пустой ячейке)

Кажется, это близко, потому что, если есть 3 значения, он вернет 2 запятых, но без имен. Есть идеи?

Sub CustomerCodeLookup()

'sets the sheet I'm searching (P1), The sheet where the list of codes and their group names are (P2) and creates the dictionary

Dim P1 As Range, P2 As Range
Dim T2()
Set D1 = CreateObject("scripting.dictionary")
Set P1 = ActiveSheet.UsedRange
Set P2 = Workbooks("ReportsMac.xlsm").Sheets("CustomerCodeReference").UsedRange
T1 = P1
T3 = P2
'Finds the number of cells with data in reference sheets, in case it     changes
For i = 1 To UBound(T3): D1(T3(i, 1)) = T3(i, 2): Next i
'finds ReportNumber Column
For i = 1 To UBound(T1, 2)
    If T1(1, i) Like "ReportNumber" Then RN = i
Next i
'Here is where problem may be, supposed to identify codes in the column, separate them by comma, and set them aside to be transposed into empty cell. 
a = 1
For i = 2 To UBound(T1)
    ReDim Preserve T2(1 To a)
    St1 = Split(Trim(T1(i, RN)), ",")
    For j = 0 To UBound(St1)
        T2(a) = T2(a) & ", " & D1(St1(j))
    Next j
    T2(a) = Mid(T2(a), 3)
    a = a + 1
Next i
'add the results to empty cell
Range("A1").End(xlToRight).Offset(1, 1).Resize(a - 1) = Application.Transpose(T2)

End Sub

Answer 1

Можете ли вы попробовать попробовать, чтобы решить эту проблему?

For i = 2 To UBound(T1)
    ReDim Preserve t2(1 To a)
    St1 = Split(Trim(T1(i, RN)), ",")
    For j = 0 To UBound(St1)
        If t2(a) = "" Then
            t2(a) = D1(St1(j))
        Else
            t2(a) = t2(a) & ", " & D1(St1(j))
        End If
    Next j
    a = a + 1
Next i