excel - 如何复制多次重复单元格？

Question

我有一张 table

Name    ID  Salary  Educ    Exp Salary  Educ    Exp
Mike    1   100     5       12    200   12      23
Peter   2   200     6       12    300   3       32
Lily    3   150     3       13    200   5       2
   ...................

我需要将此表转换为

Name    ID  Salary  Educ    Exp
Mike    1   100     5       12
Peter   2   200     6       12
Lily    3   150     3       13
Mike    1   200     12      23
Peter   2   300     3       32
Lily    3   200     5       2
   ..................

如何使用 VBA 执行此操作？

这是我迄今为止尝试过的

Sub test()
Dim rg1 As Range, rg2 As Range, rg3 As Range, shtDest As Worksheet
Dim lLoop As Long, lRowDest As Long

Set rg1 = Selection.Areas(1)
Set rg2 = Selection.Areas(2)
Set rg3 = Selection.Areas(3)
Set shtDest = Worksheets.Add

lRowDest = 1

For lLoop = 1 To rg1.Rows.Count
    lRowDest = lRowDest + rg2.Rows.Count + rg3.Rows.Count

Next



End Sub

Answer 1

查看评论后，这会将 N 组数据移动到一组列中。这假设每一行包含一个名称/ID 组合的数据，如您的示例中所示。

Sub moveData()

Dim x As Range
Dim data As Range
Dim i As Long
Dim origId As Range
Dim id As Range
Dim idColCount As Long
Dim setCount As Long
Dim setCol As Long
Dim headerRange As Range

Set headerRange = Range("1:1")
Set id = Range(Range("A2"), Range("B2").End(xlDown))
Set origId = id

idColCount = id.Columns.Count

setCount = Application.WorksheetFunction.CountIfs(headerRange, "salary")

setCol = 1
For i = 1 To setCount
  With headerRange
    Set x = .Find("Salary", .Cells(1, setCol))
    Set data = x.Offset(1).Resize(x.End(xlDown).Row - x.Row, 3)
    data.Copy
    id.Cells(1, 1).Offset(id.rows.Count, idColCount).PasteSpecial xlPasteAll
    origId.Copy
    id.Cells(1, 1).Offset(id.rows.Count).PasteSpecial xlPasteAll
    Set id = Range(id, id.End(xlDown))
  End With
  setCol = x.Column
Next i

setCol = 1
With headerRange
  Set x = .Find("Salary", .Cells(1, setCol))
  setCol = x.Column
  Set x = .Find("Salary", .Cells(1, setCol))
End With
Range(x, x.End(xlToRight).End(xlDown)).Clear

End Sub