Excel VBA：将单元格中的分隔字符串与值列进行比较

我在B列中有一个（分号分隔的）基因列表，我想从该列表中创建一个在a列中找到的基因列表

| Keep             | List                       |   | Result      |
|------------------|----------------------------|---|-------------|
| AASS;SESN1;SEPT5 | AASS                       |   | AASS        |
|                  | ARMC2;SESN1;ARMC2AS1;SEPT5 |   | SESN1;SEPT5 |
|                  |                            |   |             |

我有一个代码的开始，但它似乎只适用于部分基因列表，而不是全部

例如，单元格B2和B3中的列表被正确地提取到列C中，但单元格B4最后会有7个额外的项（但第二次运行VBA脚本会得到正确的数字和组成），而B5会在D5中产生奇怪的输出“4；5；0；2；3；1；SNORD1161”

这是到目前为止我所掌握的代码，它是由以下代码修改而来的：

任何帮助都将不胜感激！谢谢

Sub matchups2()

    Dim regex_leading As New VBScript_RegExp_55.RegExp
    Dim regex_middle As New VBScript_RegExp_55.RegExp
    Dim regex_trailing As New VBScript_RegExp_55.RegExp

    Set d = CreateObject("scripting.dictionary")
    For Each gene In Range("A2", Cells(Rows.Count, "A").End(3)).Value
        d(gene) = 1
    Next gene
    Stop

    For Each genelist In Range("B2", Cells(Rows.Count, "B").End(3))
        c = genelist.Value
        k = genelist.Row

        For Each q In Split(c, ";")
            If d(q) <> 1 Then
                c = Replace(c, q, ";")
            End If
        Next q

        regex_leading.Pattern = "^;{1,}"
        With regex_middle
            .Pattern = ";{1,}"
            .Global = True
        End With
        regex_trailing.Pattern = ";{1,}$"

        c = regex_leading.Replace(c, "")
        c = regex_middle.Replace(c, ";")
        c = regex_trailing.Replace(c, "")

        Cells(k, "D").Value = c
    Next genelist

End Sub

Sub-matchups2（）
Dim regex_作为新VBScript_RegExp_55.RegExp引导
Dim regex_middle作为新的VBScript_RegExp_55.RegExp
Dim regex_尾随为新VBScript_RegExp_55.RegExp
Set d=CreateObject（“scripting.dictionary”）
对于范围内的每个基因（“A2”，单元格（Rows.Count，“A”）。结束（3））。值
d（基因）=1
下一个基因
停止
对于范围内的每个基因列表（“B2”，单元格（Rows.Count，“B”）。结束（3））
c=基因列表。值
k=基因列表。行
对于拆分中的每个q（c，“；”）
如果d（q）1那么
c=替换（c，q，“；”）
如果结束
下一个问题
regex_leading.Pattern=“^；{1，}”
中间带regex_
.Pattern=“；{1，}”
.Global=True
以
regex_training.Pattern=“；{1，}$”
c=正则表达式_前导。替换（c，“”）
c=正则表达式_中间。替换（c，“；”）
c=正则表达式_尾随。替换（c，“”）
单元格（k，“D”）。值=c
下一个基因列表
端接头

我认为这应该适合你

Sub GenesDict()

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    'add A genes to dictionary
    Dim i As Long
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        Dim temp As Variant
        temp = Split(Cells(i, "A").Value2, ";")

        Dim j As Long
        For j = LBound(temp) To UBound(temp)
            dict.Add Trim(temp(j)), "text"
        Next j
    Next i

    'clear D
    Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row).ClearContents

    'transfer from B to D only genes in A
    For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
        temp = Split(Cells(i, "B").Value2, ";")

        For j = LBound(temp) To UBound(temp)
            If dict.exists(Trim(temp(j))) Then
                Cells(i, "D").Value2 = Cells(i, "D").Value2 & Trim(temp(j)) & ";"
            End If
        Next j

        'remove trailing ";"
        If Right(Cells(i, "D").Value2, 1) = ";" Then
            Cells(i, "D").Value2 = Left(Cells(i, "D").Value2, Len(Cells(i, "D").Value2) - 1)
        End If

    Next i

End Sub

---

你为什么还要做regex？我将根据

的拆分获取所有值

，将它们放入字典中，然后将未来的单元格与该字典进行比较，不要将第一个字典中不存在的值与Office 365一起添加回去。如果您感兴趣，可以使用公式来完成此操作。