簡體   English   中英

Excel從A列循環並查找與相應值的匹配並將它們移動到新工作表

[英]Excel looping from column A and finding matches with corresponding values and moving them to a new worksheet

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)中的匹配並報告行值,但是當我試圖考慮如何提取該名稱和相應的值並移動時我被卡住了它到排序的工作表。 我知道復制,粘貼,偏移,循環的所有通用語言,但是當我開始使用Dim時,我迷失了如何提取這些發現。

任何幫助,將不勝感激。 提前致謝!

葯物和分數表

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

如果我的理解(見問題評論)是正確的,下面的代碼應該(希望?可能?)工作:

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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM