Excel 如何复制多次重复的单元格？
我有一张桌子Excel 如何复制多次重复的单元格？,excel,vba,Excel,Vba,我有一张桌子 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
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
..................
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
查看注释后，这将N组数据移动到一组列中。这假设每一行包含一个名称/标识组合的数据，如示例中所示
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
看看这是否对您有效，它会在每一行循环查找每个Salary/Educ/Exp条目，直到找不到另一个条目为止，将每个条目移动到底部，并使用相应的名称/ID，为您很好地清理所有内容
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
Private子拆分表（）
Dim rng作为要迭代的范围“”
Dim c作为范围“”迭代器对象
Dim cc作为范围“”检查单元格
Dim lc作为范围“”的最后一个单元格
将ws设置为工作表
Dim keepLooking作为布尔“”循环对象
Dim第一次作为布尔值
作为整数的Dim偏移
Dim名称为字符串，ID为整数，工资为整数，Educ为整数，Exp为整数
设置ws=ActiveSheet''将其调整为所需的工作表，或将其保留为ActiveSheet
设置rng=ws.Range（“A2”、“A”和ws.Range（“A”和ws.Rows.Count）.End（xlUp）.Row）
对于rng中的每个c
firstTime=True“”重置为True，因此第一个条目的偏移量为5
keepLooking=True
在继续寻找的时候
如果是第一次
设置cc=c.偏移量（，5）
否则：设置cc=cc.offset（，3）
如果结束
如果抄送“”，则抄送“”，如果工资中有数据，则获取我们期望的Salaray/Educ/Exp
名称=c.值
ID=c.偏移量（，1）.值
工资=成本价值
Educ=cc.偏移量（，1）.值
Exp=cc.偏移量（，2）.值
“”清理
cc.ClearContents
抄送偏移量（，1）.ClearContents
抄送偏移量（，2）.ClearContents
“”将其移动到A:E列的底部
设置lc=ws.Range（“A”&ws.Rows.Count）.End（xlUp）.offset（1，0）
lc.Value=Name
lc.偏移量（，1）.Value=ID
lc.抵销（，2）.价值=工资
lc.偏移量（，3）.值=Educ
lc.偏移量（，4）.Value=Exp
否则：keepLooking=False
如果结束
firstTime=False“”设置为False，因此从这里开始我们只能得到3的偏移量
温德
下一个c
ws.Range（“F1”，ws.Range（“A1”）.End（xlToRight））.ClearContent
端接头
Set rg1=Selection.Areas（1）。。。（2） ..Ctrl