Vlookup 以分号分隔的多个值

Vlookup multiple values separated by semicolon

我需要帮助来对齐两列中的相同值,其中在一个单元格中有多个代码以分号分隔。

我有一个这样的专栏:

UMLS CODE
C0443147
C0441748;C4020899
C4025900
C0085606;C3544092;C4020898

我需要将以下数据与上面的列匹配。

UMLS CODE  TYPE    MEDDRA CODE         DEFINITION
C0443147    LT;PT   10014275;10014407   EEG;Electroencephalogram
C4020899    LT;PT   10014544;10014430   EMG;Electromyogram
C3544092    OL;LT   10014828;10014449   Electronystagmography
C0013854    PT;LT   10014455;10014359   Electro-oculogram

所以匹配UMLS CODES列的结果一定是这样的:

UMLS CODE                  UMLS CODE  TYPE    MEDDRA CODE         DEFINITION
C0443147                   C0443147   LT;PT   10014275;10014407   EEG;Electroencephalogram
C0441748;C4020899          C4020899   LT;PT   10014544;10014430   EMG;Electromyogram
C4025900                   -------    -----   -----------------   -------------------
C0085606;C3544092;C4020898 C3544092   OL;LT   10014828;10014449   Electronystagmography

我在 excel 上尝试了以下公式,但当查找值具有多个由分号分隔的值时,它不起作用。

=VLOOKUP($A1;$A819:$D379;COLUMN(A:A);0)

其中$A1是UMLS CODE,$A$13819:$D$63379是匹配UMLS CODE的所有数据。

图片来自UMLS代码:

图片来自UMLS数据:

需要结果,但也可以在 UMLS 代码中用分号分隔的多个值单元格中工作:

@S.Ram,

如图导入Sheet1中的数据:

导入Sheet2中的数据如图:

并尝试:

Option Explicit
Option Explicit

Sub test()

Dim LastRow1 As Long
Dim LastRow2 As Long
Dim i As Long
Dim j As Long
Dim Word As String
Dim Word1 As String
Dim Word2 As String
Dim SpecialChr As Long
Dim Position As Long
Dim Position2 As Long

LastRow1 = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
LastRow2 = Sheet2.Range("B" & Rows.Count).End(xlUp).Row

 With Sheet1

    For i = 2 To LastRow1

        SpecialChr = (Len(.Range("A" & i).Value) - Len(Replace(.Range("A" & i).Value, ";", ""))) / Len(";")

        If SpecialChr = 0 Then
            Word = .Range("A" & i).Value
            With Sheet2
                For j = 2 To LastRow2
                    If .Range("B" & j).Value = Word Then
                        .Range("B" & j).Offset(0, -1).Value = Word
                    End If
                Next j
            End With
        ElseIf SpecialChr = 1 Then
            Position = InStr(1, .Range("A" & i).Value, ";")
            Word = Left(.Range("A" & i).Value, Position - 1)
            Word1 = Right(.Range("A" & i).Value, Position - 1)
            With Sheet2
                For j = 2 To LastRow2
                    If .Range("B" & j).Value = Word Then
                        .Range("B" & j).Offset(0, -1).Value = Word
                    ElseIf .Range("B" & j).Value = Word1 Then
                        .Range("B" & j).Offset(0, -1).Value = Word1
                    End If
                Next j
            End With
        ElseIf SpecialChr = 2 Then
            Position = InStr(1, .Range("A" & i).Value, ";")
            Position2 = InStr(Position + 1, .Range("A" & i).Value, ";")
            Word = Left(.Range("A" & i).Value, Position - 1)
            Word1 = Mid(.Range("A" & i).Value, Position + 1, Len(.Range("A" & i).Value) - Position2)
            Word2 = Right(.Range("A" & i).Value, Position - 1)
            With Sheet2
                For j = 2 To LastRow2
                    If .Range("B" & j).Value = Word Then
                        .Range("B" & j).Offset(0, -1).Value = Word
                    ElseIf .Range("B" & j).Value = Word1 Then
                        .Range("B" & j).Offset(0, -1).Value = Word1
                    ElseIf .Range("B" & j).Value = Word2 Then
                        .Range("B" & j).Offset(0, -1).Value = Word2
                    End If
                Next j
            End With
        End If
    Next i
End With

End Sub

最后将结果导入Sheet2黄色区域

假设您的列表中有最大数量的 UMLS 代码(我假设有 3 个)

第 8-12 行的 table 是一个中间步骤,只是为了简化它,如果您愿意,可以将其放在最终函数中。

=TRIM(MID(SUBSTITUTE($A5;";";REPT(" ";LEN($A5))); (C$8)*LEN($A5)+1;LEN ($A5)))

=IFERROR(VLOOKUP($A12;$C$2:$F$5;4;FALSE);IFERROR(VLOOKUP($B12;$C$2:$F$5;4;FALSE);VLOOKUP($C12 ;$C$2:$F$5;4;假)))

A16 列就是 = A2 等