반복되는 셀을 여러 번 복사하는 방법은 무엇입니까?

Question

내가 가진 테이블 내가

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 
    .................. 

으로이 테이블을 변환 할 필요가

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 
    ................... 

I이 사용 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 

Answer 2

그것은 해당 이름/ID와 바닥에 각각 이동, 서로를 발견하고 정리하지 않을 때까지 각 급여/EDUC/특급 항목을 찾아 각 행을 통해 루프, 참조 당신을위한 모든 것이 멋지 네요.

Private Sub SplitTable() 

    Dim rng   As Range  '' range we want to iterate through 
    Dim c   As Range  '' iterator object 
    Dim cc   As Range  '' check cell 
    Dim lc   As Range  '' last cell 
    Dim ws   As Worksheet 
    Dim keepLooking As Boolean  '' loop object 
    Dim firstTime As Boolean 
    Dim offset  As Integer 

    Dim Name As String, ID As Integer, Salary As Integer, Educ As Integer, Exp As Integer 

    Set ws = ActiveSheet '' adjust this to the sheet you want or leave it as ActiveSheet 
    Set rng = ws.Range("A2", "A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row) 
    For Each c In rng 
     firstTime = True '' reset to true so we get an offset of five for the first entry 
     keepLooking = True 
     While keepLooking 
      If firstTime Then 
       Set cc = c.offset(, 5) 
      Else: Set cc = cc.offset(, 3) 
      End If 

      If cc <> "" Then '' if the salary has data in it, then grab what we expect to be Salaray/Educ/Exp 
       Name = c.Value 
       ID = c.offset(, 1).Value 
       Salary = cc.Value 
       Educ = cc.offset(, 1).Value 
       Exp = cc.offset(, 2).Value 

       '' Cleanup 
       cc.ClearContents 
       cc.offset(, 1).ClearContents 
       cc.offset(, 2).ClearContents 

       '' Move it to the bottom of columns A:E 
       Set lc = ws.Range("A" & ws.Rows.Count).End(xlUp).offset(1, 0) 
       lc.Value = Name 
       lc.offset(, 1).Value = ID 
       lc.offset(, 2).Value = Salary 
       lc.offset(, 3).Value = Educ 
       lc.offset(, 4).Value = Exp 
      Else: keepLooking = False 
      End If 

      firstTime = False '' set to false so we only get an offset of 3 from here on out 
     Wend 
    Next c 

    ws.Range("F1", ws.Range("A1").End(xlToRight)).ClearContents 

End Sub