Vba 如何在excel中将数据从一组列重新排列到另一组列？

嘿，我是VBA新手，我尝试在同一工作表中以不同格式将数据从一列移动到另一列。 原始数据如下所示：

  Type   Fx Fy Fz
1  DL     1  2  3 
1  LL     4  5  6
1  C1     7  8  9
1  C2    10  11 12
2  DL    5   6  7
2  LL    6   8  4
2  C1    3   3  4
2  C2    1   2  3 

我想将其安排到另一组列，格式类似于：

       DL            LL             C1            C2
   Fx  Fy  Fz    Fx  Fy  Fz     Fz  Fy  Fz    Fx  Fy  Fz
1   1  2    3     4   5   6      7   8   9    10  11  12 
2   5   6   7     6   8   4      3   3   4    1    2   3

我试着为这个做了录制宏，代码是这样的：

   Sub Macro2()
       Selection.Copy
        ActiveCell.Offset(-2, 7).Range("A1").Select
        ActiveSheet.Paste
        ActiveCell.Offset(2, -5).Range("A1:C1").Select
        Application.CutCopyMode = False
        Selection.Copy
        ActiveCell.Offset(-2, 6).Range("A1").Select
        ActiveSheet.Paste
        ActiveCell.Offset(3, -6).Range("A1:C1").Select
        Application.CutCopyMode = False
        Selection.Copy
        ActiveCell.Offset(-3, 9).Range("A1").Select
        ActiveSheet.Paste
        ActiveCell.Offset(4, -9).Range("A1:C1").Select
        Application.CutCopyMode = False
        Selection.Copy
        ActiveCell.Offset(-4, 12).Range("A1").Select
        ActiveSheet.Paste
        ActiveCell.Offset(5, -12).Range("A1:C1").Select
        Application.CutCopyMode = False
        Selection.Copy
        ActiveCell.Offset(-5, 15).Range("A1").Select
        ActiveSheet.Paste
        ActiveCell.Offset(6, -17).Range("A1").Select
        Application.CutCopyMode = False
        Selection.Copy
        ActiveCell.Offset(-5, 7).Range("A1").Select
        ActiveSheet.Paste
        ActiveCell.Offset(5, -5).Range("A1:C1").Select
        Application.CutCopyMode = False
        Selection.Copy
        ActiveCell.Offset(-5, 6).Range("A1").Select
        ActiveSheet.Paste
        ActiveCell.Offset(6, -6).Range("A1:C1").Select
        Application.CutCopyMode = False
        Selection.Copy
        ActiveCell.Offset(-6, 9).Range("A1").Select
        ActiveSheet.Paste
        ActiveCell.Offset(7, -9).Range("A1:C1").Select
        Application.CutCopyMode = False
        Selection.Copy
        ActiveCell.Offset(-7, 12).Range("A1").Select
        ActiveSheet.Paste
        ActiveCell.Offset(8, -12).Range("A1:C1").Select
        Application.CutCopyMode = False
        Selection.Copy
        ActiveCell.Offset(-8, 15).Range("A1").Select
        ActiveSheet.Paste
    End Sub

---

您是否考虑过使用透视表而不是硬编码的宏重新格式化？还有，您的问题是什么？源代码中的

1

和

2

是否确实是数据的一部分？从未使用过透视表的用户将尝试使用它…我的问题是将源代码1的格式转换为源代码2的格式。而1和2实际上是由我键入的。。。我试着复制和粘贴，但它的格式很奇怪，所以我只是手写了所有的东西

Sub moveit()

    Dim src As Worksheet, dest As Worksheet
    Dim c As Range, f As Range

    Set src = ThisWorkbook.Sheets("Sheet1")
    Set dest = ThisWorkbook.Sheets("Sheet2")

    dest.UsedRange.ClearContents 'start with empty sheet

    Set c = src.Range("a2")
    Do While Len(c.Value) > 0

        Set f = dest.Rows(1).Find(c.Value, LookIn:=xlValues, lookat:=xlWhole)
        If f Is Nothing Then
            Set f = dest.Cells(1, Columns.Count).End(xlToLeft)
            If Len(f.Value) > 0 Then Set f = f.Offset(0, 3)
            f.Value = c.Value
            src.Range("B1:D1").Copy f.Offset(1, 0)
        End If
        c.Offset(0, 1).Resize(1, 3).Copy dest.Cells(Rows.Count, f.Column).End(xlUp).Offset(1, 0)

        Set c = c.Offset(1, 0)

    Loop


End Sub