Excel宏將數據從一個表格轉置到另一個表格的名稱和單元格內容

Question

我有一個工作表1，其中有一列標記爲參與者，列標記爲1-20（實驗ID號）。

我還有另一張工作表2，其中包含參與者（列）的數據和他們參與的實驗（列）。在實驗列下的單元格中，有多個實驗ID編號，因爲參與者參與了多個實驗。例如，一個單元格可以讀取「1,4,5」。

我需要做的是將工作表1上的「X」放在工作表2中的相應單元格中。例如，從工作表2中爲參與者「003」讀取「1,4,5」的單元格會在工作表1中標記爲1,4,5的列中放置「X」。

我希望這很清楚。我對宏完全陌生，但需要儘快提供幫助。

Answer 1

這是你的幸運日。我將通過一些代碼向您介紹如何執行此操作。但是你必須理解這些概念才能從中受益。如果你這樣做，你可以將這些想法應用於許多項目。

首先，您需要將任務分解爲易於管理的簡單步驟。由於所有不同的場景，宏不會幫助你。讓我們把它分解成幾個步驟，然後解決如何完成每個步驟。

在開始之前，請考慮Sheets（「worksheet1」）。Cells（row＃，col＃）格式。這使您可以通過使用變量遞增行號和列號來移動工作表上的單元格。
在這種情況下，oRow（原始行），nRow（新行）等

1. 只看worksheet2與會者行。 ：參與者=表（ 「worksheet2」）細胞（oRow，1）
2. 複製參與者到worksheet1柱1：表（ 「worksheet1」）細胞（nRow，1）=參與者
3. 拆分實驗細胞（「工作表2」）。單元格（oRow，2），「，」）
4. 循環顯示列表項和每個列表項，在同名列下放置一個「X」。
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 

編輯：格式化修復與代碼縮進