excel - 如何在Excel VBA中将单行列分解为多行

Question

我有一组如下所示的数据。

来源结构

但我想将项目列复制到另一张纸上的单独行中。在这种情况下，由于有四个项目，源工作表中的每一行都会在目标工作表中生成四行。

这是所需目标数据结构的图片。

目标数据结构

此数据将定期更改，新条目将添加到源底部。我已经弄清楚如何循环一系列数据，但无法弄清楚如何选择单个单元格以便在下一张纸上写入。我是 VBA 新手，因此我们将不胜感激。

Answer 1

您需要将 wsSource 和 wsTarget 的名称更改为其实际工作表名称:

Sub tgr()

    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim arrSource() As Variant
    Dim arrData() As Variant
    Dim rIndex As Long
    Dim cIndex As Long
    Dim DataIndex As Long
    Dim lNumProjects As Long

    Set wsSource = Sheets("Source")
    Set wsTarget = Sheets("Target")
    arrSource = wsSource.Range("A1").CurrentRegion.Value
    lNumProjects = UBound(arrSource, 2) - 3
    ReDim arrData(1 To lNumProjects * (UBound(arrSource, 1) - 1), 1 To 5)

    For rIndex = 2 To UBound(arrSource, 1)
        For cIndex = 1 To lNumProjects
            DataIndex = DataIndex + 1
            arrData(DataIndex, 1) = arrSource(rIndex, 1)
            arrData(DataIndex, 2) = arrSource(rIndex, 2)
            arrData(DataIndex, 3) = arrSource(rIndex, 3)
            arrData(DataIndex, 4) = arrSource(1, cIndex + 3)
            arrData(DataIndex, 5) = arrSource(rIndex, cIndex + 3)
        Next cIndex
    Next rIndex

    If DataIndex > 0 Then
        wsTarget.Range("A2:E" & Rows.Count).ClearContents
        wsTarget.Range("A2:E2").Resize(DataIndex).Value = arrData
    End If

    Set wsSource = Nothing
    Set wsTarget = Nothing
    Erase arrSource
    Erase arrData

End Sub