Question

嘿所以我是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

Answer 1

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

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

1 个答案: