Question

Excel从A列循环并查找与相应值匹配并将其移动到新工作表。

擅长VBA的新手。与A栏中的药物相比，无法创建循环以查找工作表中相应值的匹配药物名称。将在第二个工作表上按顺序报告A列的匹配。

意向：

原始数据 - 列出了来自一个细胞系的具有相应值（B列中的分数）的药物（A列）。然后在C和D列中，分别列出来自另一细胞系的药物和相应的值。这可以继续，具体取决于测试的细胞系数量。关键是并非所有细胞系都用相同的药物治疗。我们试图仅对具有相应值的匹配药物进行分类。然后，我们将能够比较药物在细胞系中的作用。

有关数据集的示例，请参阅附图。细胞系（第1行）和药物和分数（第2行）的标题占据前2行。

从我的例子中A列中的第一种药物，范围（“A3”）开始，您可以从C，E，G等列的匹配中查找，具体取决于分析的细胞系数量。如果找到匹配，则将具有相应数据的药物放在“已分类”工作表上。例如，如果报告了具有数据的3个细胞系，则来自细胞系A的原始药物名称和数据将被放置在范围（“A3，B3”）上，来自细胞系B的匹配将被放置在原始的顺序中范围（“C3，D3”）和单元格3的匹配将放在范围（“E3，F3”）上。

我们有来自许多细胞系的药物和反应（评分）数据，但并非所有药物都在每个细胞系中进行了测试。我们希望找到在所有细胞系中测试的常见药物。

我能够写一个宏（见下文）在第一个比较列（C）中找到一个匹配并报告行值，但是当我试图考虑如何提取该名称和相应的时候我被卡住了value并将其移动到已排序的工作表。我知道复制，粘贴，偏移，循环的所有通用语言，但是当我开始使用Dim时，我迷失了如何提取这些结果。

任何帮助将不胜感激。提前谢谢！

Drug and score table

Sub Find_matching_drug()

    'Declaring variables. will start with first _
    drug in column A3, then move to A4, A5, etc _
    matches with corresponding values will be sent _
    to a different worksheet

    Dim i As Integer, drug_to_find As String

    'drug_to_find (variable) is defined as A3

    drug_to_find = Range("A3").Value

    MsgBox drug_to_find

    For i = 1 To 500  ' searches column up to 500 rows for the match
        If Cells(i, 3).Value = drug_to_find Then

            MsgBox ("Found value on row " & i)
            Exit Sub
        End If
    Next i

    ' This MsgBox will only show if the loop completes with no success
    MsgBox ("Value not found in the range!")
End Sub

Answer 1

如果我的理解（见问题评论）是正确的，下面的代码应该（希望？可能？）工作：

Sub Q40986052()
    Dim src As Worksheet
    Dim dst As Worksheet
    Dim c As Long
    Dim dstrow As Long
    Dim numcols As Long

    Set src = Worksheets("Sheet1")
    Set dst = Worksheets("Sheet2")

    'copy headings
    numcols = src.Cells(2, src.Columns.Count).End(xlToLeft).Column
    src.Range(src.Cells(1, 1), src.Cells(2, numcols)).Copy dst.Range("B1")

    'create a list of all drugs
    dstrow = 3
    For c = 1 To numcols Step 2
        src.Range(src.Cells(3, c), src.Cells(src.Rows.Count, c).End(xlUp)).Copy dst.Cells(dstrow, 1)
        dstrow = dst.Cells(dst.Rows.Count, 1).End(xlUp).Row + 1
    Next

    'remove duplicate entries
    dst.Range(dst.Cells(3, 1), dst.Cells(dstrow - 1, 1)).RemoveDuplicates Columns:=1, Header:=xlNo
    dstrow = dst.Cells(dst.Rows.Count, 1).End(xlUp).Row + 1

    'create vlookups
    For c = 1 To numcols Step 2
        dst.Range(dst.Cells(3, c + 1), dst.Cells(dstrow, c + 1)).FormulaR1C1 = "=IFERROR(VLOOKUP(RC1,'" & src.Name & "'!C[-1]:C,1,FALSE),"""")"
        dst.Range(dst.Cells(3, c + 2), dst.Cells(dstrow, c + 2)).FormulaR1C1 = "=IFERROR(VLOOKUP(RC1,'" & src.Name & "'!C[-2]:C[-1],2,FALSE),"""")"
    Next

    'Calculate
    dst.Calculate

    'Convert to values
    dst.Range(dst.Cells(3, 2), dst.Cells(dstrow, numcols + 1)).Value = dst.Range(dst.Cells(3, 2), dst.Cells(dstrow, numcols + 1)).Value

    'remove temporary column
    dst.Cells(1, 1).EntireColumn.Delete

End Sub

Excel从A列循环并查找与相应值的匹配并将其移动到新工作表

1 个答案: