Vba Excel宏，用于根据列名和单元格内容将数据从一张工作表转换到另一张工作表

我有一个工作表1，其中一列标记为参与者，另一列标记为1-20（实验ID号）

我还有一张工作表2，上面有参与者的数据（列）和他们参与的实验（列）。在“实验”列下的单元格中，有多个实验ID号，因为参与者参与了多个实验。例如，一个单元格可以读取“1,4,5”

我需要做的是在工作表1上，在工作表2的相应单元格中放置一个“X”。例如，从工作表2中为参与者“003”读取“1,4,5”的单元格将在工作表1中标记为1,4,5的列中放置一个“X”

---

我希望这是清楚的。我对宏完全陌生，但需要尽快帮助

今天是你的幸运日。我将带着一些代码向您介绍如何做到这一点。但是你必须理解这些概念才能从中受益。如果你这样做了，你可以将这些想法应用到许多项目中

首先，您需要将任务分解为易于管理的简单步骤。由于各种不同的场景，宏不会对您有所帮助。让我们将其分解为几个步骤，然后讨论如何完成每个步骤

在开始之前，请考虑表（“WorkSeET1”）。这允许您通过使用变量增加行号和列号来移动工作表上的单元格。
在本例中，oRow（原始行）、nRow（新行）等

查看工作表2上的参与者行：参与者=表格（“工作表2”）。单元格（oRow，1）

将参与者复制到工作表1第1列：表格（“工作表1”）。单元格（nRow，1）=参与者

将实验单元格拆分为一个列表：拆分（工作表2）。单元格（oRow，2），“，”）

循环浏览列表项，并在相同名称的列下为每个项添加一个“X”

对工作表2上的每一行（参与者条目）重复步骤1-4

声明变量。在本例中，我在方法之外声明它们，因为我在两个方法中使用它们

Dim lastRow1 As Integer
Dim lastRow2 As Integer
Dim lastCol1 As Integer

现在是方法

Sub ExperimentMover()

Dim expList() As String
Dim nRow As Integer
Dim oRow As Integer
Dim participant As String
Dim iCol As Integer

    Call GetLastRows
    nRow = lastRow1 + 1

    'Loop through the contents on Worksheet2 one Row at a time
    For oRow = 2 To lastRow2

        'Get the Participant and store it as a variable.
        participant = Sheets("worksheet2").Cells(oRow, 1)
        'Create a list of the items in the experiments cell, splitting using ","
        expList = Split(Sheets("worksheet2").Cells(oRow, 2), ",")

        'Set the participant in worksheet1
        Sheets("worksheet1").Cells(nRow, 1) = participant

        For Each experiment In expList

            'Loop through each column on worksheet1
            For iCol = 2 To lastCol1
                'Set the column Name and then check it to see if it matches Experiment
                colName = Sheets("worksheet1").Cells(1, iCol).Text
                If colName = experiment Then
                    Sheets("worksheet1").Cells(nRow, iCol) = "X"
                    Exit For
                End If
            Next iCol
        Next experiment

    'Increment the row number on worksheet1.  It should be matching the row on worksheet2
    nRow = nRow + 1

    Next oRow

End Sub

下面是GetLastRows子例程。我喜欢将它分开，因为在项目中有很多次我需要调用它。最好只是有一个方法，你可以测试和验证工作，然后如果你必须改变一些东西，你改变一件事。而不是15个电话，可能错过一个

Private Sub GetLastRows()

lastRow1 = Sheets("worksheet1").Range("A65536").End(xlUp).Row
lastRow2 = Sheets("worksheet2").Range("A65536").End(xlUp).Row
lastCol1 = Sheets("worksheet1").Cells(1, Columns.Count).End(xlToLeft).Column

End Sub

---

编辑：使用代码缩进设置格式修复程序

您可以消除一些额外的代码，但这样做成本不会太高，而且更容易看到变量名而不是长表达式。例如，您根本不需要变量colName。我知道，当我刚刚开始（现在仍然如此）的时候，看到这样的情景有助于我的大脑。以此为例。您可以使用------origString=Sheets（“工作表1”）。单元格（oRow，2），“，”）代替拆分。单元格（oRow，2）---拆分（origString，”，”），非常感谢！这非常有帮助。以后可以随意将帖子标记为答案，这有助于让未来的用户知道应该立即关注哪些解决方案。