excel - Excel VBA:将单元格中的分隔字符串与值列进行比较
问题描述
我在 BI 列中有一个(分号分隔的)基因列表,要从该列表中创建,这是在 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”。
这是我到目前为止的代码,它是从以下位置修改的:https ://www.mrexcel.com/forum/excel-questions/654920-match-comma-delimited-values-cell-against-individual-values-column .html
任何帮助,将不胜感激!谢谢!
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 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
推荐阅读
- authentication - Testcafe 身份验证问题
- php - Yii2 RBAC 不工作 - 允许访问所有内容
- c++ - 静态库避免名称冲突的建议
- android - Android studio - 将项目复制到另一台计算机后重复类
- scala - scala spark UDF ClassCastException:WrappedArray$ofRef 无法转换为 [Lscala.Tuple2
- azure-devops - Azure DevOps 创建发布
- c - 将函数指针强制转换为 C 中的另一个函数指针是否安全?
- node.js - Mongoose groupBy 多个值
- python - 如何在 BOKEH 条形图中修改类别文本大小?
- algorithm - 什么是 1.5n 比较?