我有一个需要合并的标准的主电子表格,但不确定如何将其自动化。
数据如下所示:
Unique ID | Info | Info 2 | Info 3 | Criteria 1 | Info for Criteria 1 | Criteria 2 | Info for Criteria 2
1234 | ABC | 1/1/20 | Active | Plan 1 | 1/1/2020 | Plan 2 | 3/15/2020
4567 | DEF | 2/1/20 | Active | Plan 1 | 1/5/2020 | Plan 2 | 2/15/2020
9874 | HJD | 2/1/20 | Active | Plan 1 | 3/5/2020 | |
And I need it to look like this:
Unique ID | Info | Info 2 | Info 3 | Criteria 1 | Info for Criteria 1
1234 | ABC | 1/1/20 | Active | Plan 1 | 1/1/2020
1234 | ABC | 1/1/20 | Active | Plan 2 | 3/15/2020
4567 | DEF | 2/1/20 | Active | Plan 1 | 1/5/2020
4567 | DEF | 2/1/20 | Active | Plan 2 | 2/15/2020
9874 | HJD | 2/1/20 | Active | Plan 1 | 3/5/2020
标准和特定于标准的信息列在列之间重复,我需要将所有这些信息堆叠在行中,并重复第一组数据(COL1到4)。
我不知道自动化这个过程最有效的方法是什么。目前,它需要大量的复制和粘贴。我想写一个宏,它将通过重复的标准,复制信息并将其粘贴到数据的底部。该表始终具有相同的格式和相同数量的重复标准(27)。
任何在正确方向上的推动都将是令人难以置信的感激之情。
发布于 2020-07-28 03:23:14
在宏中使用此宏更改工作表和工作簿名称。请在使用宏之前备份您的数据,因为如果您不喜欢结果,则不会使用撤消进行反转。
Private Sub combine()
Dim lastdata As Long
Dim wb As Workbook
Dim ws1 As Worksheet
Dim i As Long
lastdata = Cells(Rows.Count, 1).End(xlUp).Row
Set wb = Workbooks("book1.xlsm") 'Change Workbook Name
Set ws1 = wb.Worksheets("sheet1") 'Change Worksheet Name
For i = lastdata To 2 Step -1
If ws1.Cells(i, Columns.Count).End(xlToLeft).Column > 6 Then
ws1.Rows(i).Insert
ws1.Cells(i + 1, 1).Resize(1, 4).Copy Destination:=Cells(i, 1)
ws1.Cells(i + 1, 7).Resize(1, 2).Cut Destination:=Cells(i, 5)
End If
Next i
End Sub
https://stackoverflow.com/questions/63121185
复制相似问题