------ 需求案例------ 要求根据公司部门的出现次数,重新排列部门。用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()通用函数用于获取某数据区域列中的最后一个单元格行号。 ------ 思路1------ 综合运用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只能对数组的最后一维进行扩充。 |
|
来自: 神奇的ExcelVBA > 《待分类》