Excel宏将数据从一个工作表转换为另一个工作表的列名称和单元格内容

Question

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

我有另一张工作表2，其中包含参与者的数据（列）和他们参与的实验（列）。在实验栏下的细胞中，参与者参与了多个实验，有多个实验ID号。例如，一个单元格可以读取“1,4,5”。

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

我希望这很清楚。我是宏的新手，但需要尽快帮助。

Answer 1

这是你的幸运日。我将通过一些代码指导您完成此操作。但是你必须理解这些概念才能从中受益。如果您这样做，您可以将这些想法应用于许多项目。

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

在开始之前，请考虑表格（＆＃34;工作表1和＃34;）。单元格（行＃，col＃）格式。这允许您通过使用变量递增行号和列号来移动工作表上的单元格 在这种情况下，oRow（原始行），nRow（新行）等

1. 查看工作表2上的Participant行。 ：participant = Sheets（＆＃34; worksheet2＆＃34;）。Cells（oRow，1）
2. 将参与者复制到工作表1第1列：表格（＆＃34;工作表1＆＃34;）。单元格（nRow，1）=参与者
3. 将实验单元拆分为一个列表：拆分（表格（＆＃34;工作表2＆＃34;）。单元格（oRow，2），＆＃34;，＆＃34;）
4. 循环显示列表项目，并为每个项目添加一个＆＃34; X＆＃34;在同名栏目下。
5. 对工作表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





编辑：使用代码缩进格式化修复