excel - 如何将表格从一张纸移动到另一张纸，同时将其重新排列为特定格式？

Question

所以我想在 excel 中获取一张看起来像这样的表格：

姓名	原因	理由
鲍勃	他很酷	骑自行车
乔治	他很聪明	耶鲁

并让它填写另一张表格，如下所示：

人	注释
姓名	鲍勃
原因	他很酷
理由	骑自行车
人	注释
姓名	乔治
原因	他很聪明
理由	耶鲁

（包括空白行）

现在这不是一个数据透视表或转置表，所以我正在寻找任何可以帮助我实现这一目标的方向。不幸的是，我什至不知道正确的词来谷歌寻找一个好的答案。

任何帮助将不胜感激

标签： excel

Answer 1

按下F11并将以下代码复制到一个新模块中（看看如何）

阅读代码的注释并根据您的需要进行调整

通过按键运行它F8（看看如何）

Public Sub rearrangeData()

    ' Set a reference to the source sheet
    Dim sourceSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
    
    ' Set a reference to the target sheet
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Worksheets("Sheet2")
    
    ' Set a reference to the source range (including headers)
    Dim sourceRange As Range
    Set sourceRange = sourceSheet.Range("A1:C4")
    
    ' Set a reference to the first cell in target sheet
    Dim targetFirstCell As Range
    Set targetFirstCell = targetSheet.Range("A1")
    
    ' Set a reference to the source range (excluding headers and just the first column)
    Dim sourceBodyRange As Range
    Set sourceBodyRange = sourceRange.Columns(1).Offset(1, 0).Resize(sourceRange.Rows.Count - 1)
    
    ' Store source headers in array
    Dim sourceHeaders As Variant
    sourceHeaders = Application.Transpose(sourceRange.Rows(1).Value)
    
    ' Count number of header cells
    Dim headerCellsCounter As Long
    headerCellsCounter = UBound(sourceHeaders)
    
    ' Start a counter for source cells
    Dim sourceCellCounter As Long
    sourceCellCounter = 1
    
    ' Write the data from source to target (loop through cells in first column and refer to other cells by using offset)
    Dim sourceCell As Range
    For Each sourceCell In sourceBodyRange.Cells
    
        ' Print data headers in target sheet
        targetFirstCell.Offset(sourceCellCounter - 1, 0).Value = "Person"
        targetFirstCell.Offset(sourceCellCounter - 1, 1).Value = "Comments"
    
        ' Print headers in target sheet
        targetFirstCell.Offset(sourceCellCounter, 0).Resize(headerCellsCounter, 1).Value = sourceHeaders

        ' Print row values
        targetFirstCell.Offset(sourceCellCounter, 1).Resize(headerCellsCounter, 1).Value = Application.Transpose(sourceCell.Resize(1, headerCellsCounter).Value)
        
        ' Increase rows
        sourceCellCounter = sourceCellCounter + headerCellsCounter + 2
        
    Next sourceCell

End Sub

让我知道它是否有效