VBA实现Excel行列(单元格)数据上下左右移动

Admin | 2008-5-23 19:30:17 | 被阅次数 | 30046

温馨提示!

如果未能解决您的问题，请点击搜索；登陆可复制文章，点击登陆

　　如标题所言…

　　说啥都没用，反正，事实胜于雄辩，先看下图的例子再说！

　　上图中，左上角有四个按钮，分别为“上移、下移、左移和右移”，其功能不言而喻；

　　操作对象可以分为三种，即只选择某一个单元格的数据，或选择整行，或选择整列；无论选择哪种，都可轻松实现移动；

　　该需求为网上一网友之业务需求，该功能的实现为网上一热情之士—“木村雄仔”提供源代码，版权归原作者所有！

　　下面提供源代码：

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Sub 上移()
On Error Resume Next
i = Selection.Rows.Count
    Selection.Cut
    Selection.Offset(-1, 0).Insert
    Selection.Offset(-1, 0).Select
End Sub
Sub 下移()
On Error Resume Next
i = Selection.Rows.Count
    Selection.Cut
   Selection.Offset(i + 1, 0).Insert
   Selection.Offset(1, 0).Select
End Sub
Sub 左移()
On Error Resume Next

    Selection.Cut
    Selection.Offset(0, -1).Insert
    Selection.Offset(0, -1).Select
End Sub
Sub 右移()
On Error Resume Next
i = Selection.Columns.Count
    Selection.Cut
   Selection.Offset(0, i + 1).Insert
   Selection.Offset(0, 1).Select
End Sub
Sub addc()
For Each menua In Application.CommandBars '遍历工具栏,判断工具是否存在,有则删除
If menua.Name = "DT" Then Application.CommandBars("DT").Delete
Next
Dim 主菜单 As CommandBar
Set 主菜单 = Application.CommandBars.Add(temporary:=True)
With 主菜单
    .Visible = True
    .Name = "DT"
    .Position = msoBarTop

    '******************开始添加文件子菜单*********************

Set 命令按钮 = .Controls.Add
       With 命令按钮
         .Caption = "上移"
         .FaceId = 134
         .OnAction = "上移"
         .Style = msoButtonIconAndCaptionBelow
         End With
           Set 命令按钮 = .Controls.Add
       With 命令按钮
         .Caption = "下移"
         .FaceId = 135
         .OnAction = "下移"
         .Style = msoButtonIconAndCaptionBelow
         End With
     Set 命令按钮 = .Controls.Add
       With 命令按钮
         .Caption = "左移"
         .FaceId = 132
         .OnAction = "左移"
         .Style = msoButtonIconAndCaptionBelow
         End With
           Set 命令按钮 = .Controls.Add
       With 命令按钮
         .Caption = "右移"
         .FaceId = 133
         .OnAction = "右移"
         .Style = msoButtonIconAndCaptionBelow
         End With
   End With
End Sub