在excel中复制每个单元N次

例：

之前

name1 name2 name3 

后

 name1 name1 name1 name1 name2 name2 name2 name2 name3 name3 name3 name3 

这是代码，但它给我一个错误。 运行时错误“9”：下标超出范围。

  Sub test() Dim rng As Range, c As Range Dim rng1 As Range, c1 As Range Dim dest As Range, j As Integer, k As Integer Worksheets("sheet2").Cells.Clear With Worksheets("sheet1") Set rng = Range(.Range("A2"), .Range("A2").End(xlDown)) j = WorksheetFunction.CountA(.Rows("1:1")) 'msgbox j For Each c In rng Set rng1 = Range(c.Offset(0, 1), .Cells(c.Row, Columns.Count).End(xlToLeft)) 'msgbox rng1.Address For Each c1 In rng1 Set dest = Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0) 'msgbox dest.Address If c1 = "" Then GoTo line1 'dest.Offset(0, 0) = c 'dest.Offset(0, 1) = .Cells(1, c1.Column) 'dest.Offset(0, 2) = c1 dest = c dest.Offset(0, 1) = c1 dest.Offset(0, 2) = .Cells(1, c1.Column) line1: Next c1 Next c End With With Worksheets("sheet2").Columns("c:c") .NumberFormat = "dd-mmm-yy" End With End Sub 

Answer 1

这个尝试完全避免了循环…..我认为这不会对Chris的代码速度产生太大的影响，这是我自己的挑战，通过只用数组操作string来避免循环

更改lngRepeatvariables以更改所需的重新sorting

代码中的大部分复杂性来自于需要在每个单元格的末尾添加一个分隔符 ，即如果inputstring的forms

“NAME1，”
“NAME2”
“NAME3”

而不是

 “name1” “name2” ”name3” 

那么string操作会被缩短

 Sub Reduct() Dim X Dim Y Dim strDelim As String Dim lngRepeat As Long strDelim = "," lngRepeat = 4 Y = Split(Replace(Join(Application.Transpose(Range([A1], Cells(Rows.Count, "A").End(xlUp))), strDelim), strDelim, "|" & strDelim), strDelim) Y(UBound(Y)) = Y(UBound(Y)) & "|" X = Replace(Replace(Join(Application.Rept(Y, lngRepeat), strDelim), "|", strDelim), strDelim & strDelim, strDelim) [b1].Resize((UBound(Y) - LBound(Y) + 1) * lngRepeat, 1) = Application.Transpose(Split(X, strDelim)) End Sub 

Answer 2

您的示例数据表明您希望在行中进行重复，但是您的代码build议您要在列中进行重复。

这里有两个版本：

 Sub DuplicateInRows() Dim NumDups As Long Dim rSrc As Range Dim dSrc As Variant Dim rDst As Range Dim dDst() As Variant Dim i As Long, j As Long NumDups = 3 With Worksheets("sheet1") Set rSrc = .Range(.Range("A2"), .Range("A2").End(xlDown)) End With dSrc = rSrc ReDim dDst(1 To UBound(dSrc, 1) * NumDups, 1 To 1) For i = 0 To UBound(dSrc, 1) - 1 For j = 0 To NumDups - 1 dDst(i * NumDups + j + 1, 1) = dSrc(i + 1, 1) Next Next With Worksheets("sheet2") .Cells.Clear Set rDst = .Range("A1:A" & UBound(dDst, 1)) rDst = dDst End With End Sub Sub DuplicateInColumns() Dim NumDups As Long Dim rSrc As Range Dim dSrc As Variant Dim rDst As Range Dim dDst() As Variant Dim i As Long, j As Long NumDups = 3 With Worksheets("sheet1") Set rSrc = Range(.Range("A2"), .Range("A2").End(xlDown)) End With dSrc = rSrc ReDim dDst(1 To UBound(dSrc, 1), 1 To NumDups) For i = 0 To UBound(dSrc, 1) - 1 For j = 0 To NumDups - 1 dDst(i + 1, j + 1) = dSrc(i + 1, 1) Next Next With Worksheets("sheet2") .Cells.Clear Set rDst = .Range("A1", .Cells(UBound(dDst, 1), UBound(dDst, 2))) rDst = dDst End With End Sub 

注意：使用变体arrays比直接操作单元要快得多

Answer 3

find正确的答案：

 Sub insertrows() MyColumn = "A" For x = Cells(Rows.Count, MyColumn).End(xlUp).row To 1 Step -1 Rows(x).Copy Rows(x).Resize(7).Insert Next x End Sub 

如果你有例如：1 2 3 4和Resize（7），它将有八个1，八个2等。

Answer 4

坦率地说，我不能为读你的代码而烦恼。

用这个：

 Sub duplicate(n As Integer) Dim found As Range Dim i As Integer, _ numRows As Integer Set found = Range("A:A").Find("*", _ Range("A1"), _ LookIn:=xlFormulas, _ searchdirection:=xlPrevious) If Not found Is Nothing Then numRows = found.Row For i = numRows To 1 Step -1 Range(Cells((found.Row - 1) * n + 1, 1), _ Cells(found.Row * n, 1)).Value = found.Value If found.Row > 1 Then Set found = found.Offset(-1, 0) End If Next i End If End Sub