编按：

复制、粘贴，同学们一定不陌生，大部分的情况下，都可以选中区域，CTRL+C，CTRL+V搞定。但是如果遇到数据有复制次数的限制又怎么办呢？赶紧来看一看吧！

这是作者的一个朋友问的问题，按照复制次数在E:F列中粘贴内容，效果图如下：

这样的情况，同学们如何处理呢？还是CTRL+C、CTRL+V？那也是可以操作的，详细见动图：

如果，这份数据有几千行的话，使用快捷键就极有可能出错。今天就让我们来看看如何用3段VBA代码来解决这个问题吧！

第一段代码：

Sub 按指定次数复制()

  Range("E2:F10000").ClearContents

  For Each rng In Range("C2:C" & Cells(Rows.Count, "C").End(3).Row)

    Range(Cells(rng.Row, "A"), Cells(rng.Row, "B")).Copy

    For i = 1 To Cells(rng.Row, "C")

      Cells(Cells(Rows.Count, "E").End(3).Row + 1, "E").Select

      ActiveSheet.Paste

    Next i

  Next

End Sub

代码解析：

''Line1:工程起始语句

''Line2:清空E2:F10000区域原有的数据

''Line3:在“复制次数”的C列中，循环每一个单元格变量rng

''Line4:使用copy方法，复制对应行的AB两列单元格

''Line5:按照C列中的复制次数，确定循环次数

''Line6:选中E列最后一个没有值的空单元格

''Line7:使用Paste方法粘贴

''Line8:结束i变量的循环

''Line9:结束对单元格的循环

''Line10:工程结束语句

这是典型的把手动操作“直译”为代码的过程，遍历“复制次数”，然后就COPY和PASTE，相当于就是让代码去CTRL+C和CTRL+V。虽然功能上可以达到要求，但是对于代码的运算效率来说，也只能是解放了双手的劳动，而不能很好提速。

第二段代码：

Sub 按指定次数复制2()

  arr = Range("A2:C" & [A10000].End(3).Row)

  a = Application.WorksheetFunction.Sum(Application.Index(arr, , 3))

  ReDim brr(1 To a, 1 To 2)

  For i = 1 To UBound(arr)

    For j = 1 To arr(i, 3)

      k = k + 1

      brr(k, 1) = arr(i, 1)

      brr(k, 2) = arr(i, 2)

    Next j

  Next i

  Range("E2:F10000").ClearContents

  [E2].Resize(UBound(brr), UBound(brr, 2)) = brr

End Sub

代码解析：

‘’Line1:工程起始语句

‘’Line2:将A~C列装入数组arr

‘’Line3:按照数组第3列的复制总次数，确定新数组brr的行数

‘’Line4:定义新数组brr

‘’Line5:循环数组arr

‘’Line6:此行判断需要复制x次

‘’Line7:计数，确定新数组当下要处理的行号

‘’Line8:将arr第1列的对应内容赋值给新数组brr的第1列

‘’Line9:将arr第2列的对应内容赋值给新数组brr的第2列

‘’Line10:结束当下的复制过程

‘’Line11:进行下一列关键字的复制过程

‘’Line12:清空E1：F10000的区域

‘’Line13:将新数组赋值给从E1单元格开始的区域

‘’Line14:工程结束语句

将操作对象的过程，转换成放到内存数组中运算，这样的操作对于代码的运行效率是相当有效果的。只是这十几行的统计，大家可以从动图中感觉到快慢了吧！那么还有没有其他的代码可以解决“按次数复制粘贴”的过程呢？答案是肯定的。

第三段代码：

Sub 按指定次数复制3()

  arr = Range("A2:C" & [A10000].End(3).Row)

  Set d = CreateObject("scripting.dictionary")

  For i = 1 To UBound(arr)

    For j = 1 To arr(i, 3)

      d(arr(i, 1) & "|" & arr(i, 2) & "|" & j) = ""

    Next j

  Next i

  Range("E2:F10000").ClearContents

  For Each d1 In d.keys

    k = k + 1

    Cells(k + 1, 5).Resize(1, 2) = Split(d1, "|")

  Next

End Sub

代码解析：

''Line1:工程起始语句

''Line2:将A~C列装入数组arr

''Line3:创建变量d为字典变量

''Line4:循环数组arr

''Line5:判断需要复制x次

''Line6:将数组arr的第1列、第2列、被复制的次数序号，用|符号链接起来最为新的关键字，赋值到字典中

''Line7:结束当下的复制过程

''Line8:进行下一列关键字的复制过程

''Line9:清空E1：F10000的区域

''Line10:在字典d中循环每一个字典关键字元素

''Line11:计数，确定单元格对应的行号

''Line12:从E2单元格开始逐行赋值，用split函数按照|符号拆分字符串（相当于分列的功能）

''Line13:结束字典变量循环

''Line14:工程结束语句

这第三段代码，是使用了“字典”功能来处理的。虽然也在使用数组，但是不得不说，字典的运行效率要比数组会更快。如果我们要处理一个几千、几万行数据的情况，第四种方式的处理效率，就会立竿见影。

【结束语】

很多同学都是“谈VBA色变”，甚至是抵触，但是作者E图表述在十几年的实际工作EXCEL操作中总结出一句话，在这里和大家分享：函数学的越多，只会让你的工作越来越多，因为你的能力强，领导自然让你多分担；只有学会使用VBA，才能让你真正的解放双手，从众多统计员中脱颖而出，才有可能升职加薪。

所以不要再说学EXCEL没用，而是你要学习有用且可变现的能力。

本文配套的练习课件请加入QQ群：902294808下载。

做Excel高手，快速提升工作效率，部落窝教育《一周Excel直通车》视频和《Excel极速贯通班》直播课全心为你！

扫下方二维码关注公众号，可随时随地学习Excel：

相关推荐：

将excel中的数据按照指定数量进行重复，非得用VBA才能实现吗？

如何在特定位置批量插入空行等12种实用办公技巧

4种删除excel重复值的小妙招，速收藏

Power Query的数据替换技巧比Excel函数更万能！

版权申明：

本文作者E图表述；同时部落窝教育享有专有使用权。若需转载请联系部落窝教育。