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

Option Explicit

Public numBeginRows, numBeginColumns, numEndRows, numEndColumns As Integer

Function 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 编辑器，新建标准模块，将以上代码直接复制粘贴即可。