使用脚本字典查找值,然后打印键

时间:2018-04-17 20:32:21

标签: arrays excel vba scripting.dictionary

所以在提出几个问题之后,在其他人的帮助下,我现在处于以下状态,我有一个宏的下面的VBA脚本。它引用了客户代码的主列表以及它们代表的组(工作表“CustomerCodeReference”)。它应该比较拉出报告中的值(在标记为“ReportNumber”的列下)并查找该列中列出的客户代码,并在下一个可用的空列中返回已解码的名称。

截至目前,如果“ReportNumber”列包含报告编号:

“A20312345678901,A20212345678901”它应该比较客户代码(前4个字符的数字,在上面的例子中它们是“A203,A202”)在“CustomerCodeReference”表中找到它们,然后返回组名他们在空栏中提到(在这种情况下是“B队,A队”)

但问题是,如果有多个值,它只是返回逗号,如果单元格中只有一个报告号,则没有任何内容。 (所以“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

1 个答案:

答案 0 :(得分:0)

您可以尝试一下,看看这是否可以解决问题?

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
相关问题