列追加数据_《神奇的VBA》编程：根据次数重复排列数据

案例：要求根据公司部门的出现次数，重新排列部门。用Excel VBA编程应该如何写呢？
本篇，神奇的VBA依旧介绍3种思路：

思路1：全部使用For..Next循环语句遍历A列和相应B列的数据， 并在C列中再次使用循环存入数据。

Sub 重复排序_思路1()
Dim n As Integer          
Dim x As String               
Dim y As Integer            
Dim t As Integer               
​
For n = 2 To GetLastRowNumber("A")
    x = Range("A" & n)                          '获取要重复的数据
    y = Range("B" & n)                          '获取要重复的数量
    r = GetLastRowNumber("C") + 1               '获取C列追加数据的最新行号
    '存放结果
For t = 1 To y                              '根据出现次数重复执行
        Range("C" & r) = x                      
        r = r + 1
        Sleep (200)    Next
Next
End Sub
'通用函数：获取某列数据区域中最后一行的行号
Function GetLastRowNumber(col As String) As Long
GetLastRowNumber = ActiveSheet.Cells(1048576, col).End(xlUp).Row
End Function

注：本例中编写了GetLastRowNumber()通用函数用于获取某数据区域列中的最后一个单元格行号。

思路2：综合运用For..Next循环语句和字典。

Sub 重复排序_思路2()
Dim n As Integer
Dim r As Integer
Dim t As Integer
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
​
For n = 2 To GetLastRowNumber("A")
    dic.Add Range("A" & n).Value, Range("B" & n).Value
Next
​
For Each k In dic.keys
    r = GetLastRowNumber("C") + 1 '获取C列追加数据的最新行号
    '存放结果
For n = 1 To dic(k)     '根据y变量值重复运行
        Range("C" & r) = k   
        r = r + 1         
    Next
Next
End Sub
'通用函数：获取某列数据区域中最后一行的行号
Function GetLastRowNumber(col As String) As Long
GetLastRowNumber = ActiveSheet.Cells(1048576, col).End(xlUp).Row
End Function

如果您觉得代码中的这段比较啰嗦

For Each k In dic.keys
    r = GetLastRowNumber("C") + 1 '获取C列追加数据的最新行号
    '存放结果
For n = 1 To dic(k)     '根据y变量值重复运行
        Range("C" & r) = k   
        r = r + 1          
    Next
Next

你也可以简写为​

For Each k In dic.keys
    r = GetLastRowNumber("C") + 1 '获取C列追加数据的最新行号
    Range("C" & r).Resize(dic(k), 1) = k '存放结果
Next
​

思路3：运用数组,将A列数据以B列对应记载的重复数量存放入数组，最终将数组一次性导入C列区域中。

Sub 重复排序_思路3()
Dim n As Integer   
Dim x As Integer   
Dim p As Integer   
Dim arr()        '创建动态数组
​
p = 0           '初始化变量p
For n = 2 To GetLastRowNumber("A") '遍历A列数据
x = Range("B" & n)             '获取B列对应重复数量
p = p + x                      '重新设置P值
ReDim Preserve arr(1 To p)     '根据P值重新定义动态数组arr的容量
For i = p To p - x + 1 Step -1
arr(i) = Range("A" & n)    '向新添加的容量中载入数据
Next
Next
r = GetLastRowNumber("C") + 1       '获取C列追加数据的最新行号
Range("C" & r).Resize(UBound(arr), 1) = Application.Transpose(arr) '存放结果
End Sub

思路3中采用动态数组并通过反序遍历的方式向数组写入数据，有点绕脑。阅读理解时需要有点耐心。另外务必不要忘记“Step -1”。

思路3中的方法需要一定的数组知识，并在对动态数组要求一定的了解。务必要搞清楚ReDim和ReDim Preserve关键字的作用。ReDim在重新定义数组容量时会清除数组，而ReDim Preserve将会保留数组的元素。ReDim关键字的作用是重新分配数组空间。默认情况下重新分配空间后数组内容都会清空，但是如果加上Preserve后可以保留原来的数据再进行分配空间,另外需要注意的是Redim只能对数组的最后一维进行扩充。

------ 结语 ------

本篇的分享就到这里！如果你阅读了以往的文章，会发现神奇的VBA中经常用到循环遍历，逻辑判断，数组和字典。实际上职场上的数据编程，大多数就是重复运用这些基础的功能。可在Excel窗口Ribbon功能区中加载《神奇的VBA》插件学习相关基础知识。最后如果觉得本篇主题对您的工作有帮助，还请

创作不易点赞收藏

还请转发分享给更多的人

学习和掌握职场干货技能