Excel~代码实现数据行上下移动

  日常办公在使用 Excel 处理数据明细的时候常常需要上下调整各个数据行的顺序,一般的处理方式是直接剪切粘贴数据行来实现操作,数据量小,操作不太频繁的时候还可以,当数据量比较大,需要多次上下调整顺序的时候就有些麻烦了,以下代码可实现自动选取包含数据项目的数据区域并上下调整。

Option ExplicitPublic numBeginRows, numBeginColumns, numEndRows, numEndColumns As IntegerFunction UsedRangeParameter() numBeginRows = ActiveSheet.UsedRange.Cells(1, 1).Row '获取当前已用表格区域的初始行位置 numBeginColumns = ActiveSheet.UsedRange.Cells(1, 1).Column '获取当前已用表格区域的初始列位置 numEndRows = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Row - 1 '获取当前已用表格区域的末尾行位置 numEndColumns = ActiveSheet.UsedRange.Columns.Count + ActiveSheet.UsedRange.Column - 1 '获取当前已用表格区域的末尾列位置End Function'向上移动Sub qggUpTableRows() On Error Resume Next Dim i, j, numselectedRows As Integer i = Selection.Row '获取当前选中单元格的行位置 j = Selection.Column '获取当前选中单元格的列位置 numselectedRows = Selection.Rows.Count '获取当前选中的行数 Call UsedRangeParameter If i < numBeginRows Or i > numEndRows Or j < numBeginColumns Or j > numEndColumns Then MsgBox "请选择数据区域!!!" Exit Sub '目标区域不在已用表格区域内时跳出过程 End If '选中的单元格区域向上移动 Range(Cells(i, numBeginColumns), Cells((numselectedRows - 1) + i, numEndColumns)).Select Selection.Cut Selection.Offset(-1, 0).Insert Selection.Offset(-1, 0).Select End Sub'向下移动Sub qggDownTableRows() On Error Resume Next Dim i, j, numselectedRows As Integer i = Selection.Row '获取当前选中单元格的行位置 j = Selection.Column '获取当前选中单元格的列位置 numselectedRows = Selection.Rows.Count '获取当前选中的行数 Call UsedRangeParameter If i < numBeginRows Or i > numEndRows Or j < numBeginColumns Or j > numEndColumns Then MsgBox "请选择数据区域!!!" Exit Sub '目标区域不在已用表格区域内时跳出过程 End If '选中的单元格区域向下移动 Range(Cells(i, numBeginColumns), Cells(i + (numselectedRows - 1), numEndColumns)).Select Selection.Cut Selection.Offset(numselectedRows + 1, 0).Insert Selection.Offset(1, 0).Select End Sub

在打开的 Excel 文件中,进入 VBE 编辑器,新建标准模块,将以上代码直接复制粘贴即可。

发表评论

评论已关闭。

相关文章