如何在excel VBA中拆分表

Question

我有下表

id  name    attribute1  attribute2  attribute3
1   mike    red            white       red
2   hike    black          red         black
3   nike    green          green       blue

我想将ALL属性应用于这样的每一id and name行

id  name    attribute1  attribute2  attribute3
1   mike    red            white       red
1   mike    black          red         black
1   mike    green          green       blue
2   hike    red            white       red
2   hike    black          red         black
2   hike    green          green       blue
3   nike    red            white       red
3   nike    black          red         black
3   nike    green          green       blue

我怎样才能做到这一点？

Answer 1

分别选择两个范围(带Ctrl):第一个带有id和name的范围,第二个带有属性的范围(不包括任何一个的标题,然后运行附加的代码:

Sub JoinAndExpand_MultiColumnRange1()
Dim rg1 As range, rg2 As range, shtDest As Worksheet, rgCell As range
Dim lLoop As Long, lRowDest As Long

'turn off updates to speed up code execution
With application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

If selection.Areas.Count <> 2 Then
    MsgBox "Select two areas to join"
    Exit Sub
End If

Set rg1 = selection.Areas(1)
Set rg2 = selection.Areas(2)
Set shtDest = Worksheets.Add

lRowDest = 1

For lLoop = 1 To rg1.Rows.Count
    shtDest.Cells(lRowDest, 1).Resize(rg2.Rows.Count, rg1.Columns.Count).Value = rg1.Rows(lLoop).Value
    rg2.Copy shtDest.Cells(lRowDest, 1 + rg1.Columns.Count)
    lRowDest = lRowDest + rg2.Rows.Count
Next

With application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub