修正后的整行上移和整行下移动代码，兼容WPS专业版

此代码兼容了WPS，原代码因为WPS选择方式不一样导致wps无法兼容。

具体效果下载本站置顶的MQCal工程算量体验菜单功能：行上移、行下移功能。

Sub RowUP()
'行上移 修正2023年8月9日
    On Error Resume Next
    Dim SelRow&
    SelRow = Selection.Row  '取得选中行，支持wps 默认选中不一样
    If SelRow = S_Ksh Then
        MsgBox "选中行已在开始行顶端。"
        Exit Sub
    ElseIf SelRow < S_Ksh Then
        MsgBox "选中行在开始行外。"
        Exit Sub
    End If
    Selection.EntireRow.Cut
    Selection.Offset(-1).EntireRow.Insert
    If Selection.Rows.Count > 1 Then
        Rows(SelRow - 1 & ":" & SelRow - 2 + Selection.Rows.Count).Select
    Else
        Rows(SelRow - 1).Select
    End If
    'Selection.Offset(-1).Select '//原来的选中行代码，不支持wps
End Sub
Sub RowDOWN()
'行下移 修正2023年8月9日
    On Error Resume Next
    Dim SelRow&
    SelRow = Selection.Row  '取得选中行，支持wps 默认选中不一样
    If SelRow < S_Ksh Then
        MsgBox "选中行在开始行外。"
        Exit Sub
    End If
    If Selection.Rows.Count > 1 Then
        Selection.EntireRow.Cut
        Selection.Offset(Selection.Rows.Count + 1).EntireRow.Insert '选择多行下移的这行，想了很久才搞懂
        Rows(SelRow + 1 & ":" & SelRow + Selection.Rows.Count).Select
        'Selection.Offset(1).Select
    Else
        Selection.EntireRow.Cut
        Selection.Offset(2).EntireRow.Insert
        Rows(SelRow + 1).Select
        'Selection.Offset(1).Select
    End If
End Sub

[本文转自仇朝权随笔_修正后的整行上移和整行下移动代码，兼容WPS专业版](http://zawen.net/post/25.html)

分享到：

打开微信扫一扫，分享

微信里点“发现”，扫一扫

二维码将本文分享至好友或朋友圈

♡♡♡转载请保留上面信息♡♡♡