这是一组使用Exce盟敢势袂l自带的VBA对单元格数据进行颠倒或者镜像的应用程序,能够帮助你完成Excel繁杂的数据操作。
1、单元格区域上下颠倒
功能介绍:使用VBA对单元格数据进行上下颠倒操作。
应用对象要求:所选单元格区域必须没有合并的单元格,否则会出错。这时推荐使用第二种方法“单元格区域镜像”。
方法/步骤:
(1)、运行单元格区域上下颠倒程序;
(2)、选取您所要的单元格数据区域;
(3)、数据操作成功。
示例:
2、单元格区域镜像
功能介绍:使用VBA对单元格数据进行上下镜像操作。
应用对象要求:所选单元格区域可以有合并的单元格
方法/步骤:
(1)、运行单元格区域上下镜像程序;
(2)、选取您所要的单元格数据区域;
(3)、数据操作成功。
示例:
附件:
程序1:
Sub 区域数据上下颠倒()
Dim a()
Dim rg As Range
Dim m, n As Long
Dim j, k As Long
Dim r, c As Long
Dim t As Long
DoEvents
Set rg = Application.InputBox("请选择数据单元格", "提示", Type:=8)
rg.Select
j = Selection.Rows.Count
k = Selection.Columns.Count
r = Selection.Row
c = Selection.Column
ReDim a(1 To j, 1 To k)
For n = 1 To k
For m = 1 To j
a(m, n) = Cells(r + m - 1, c + n - 1)
Next m
t = 1
For m = j To 1 Step -1
Cells(r + t - 1, c + n - 1) = a(m, n)
t = t + 1
Next m
Next n
End Sub
程序2:
Sub 行镜像复制()
Dim r As Range
Dim a() As Range
Dim ac() As Range
Dim rg As Range
Set rg = Application.InputBox("请选择数据单元格区域", "单元格选择", Type:=8)
Dim i As Long
Dim n As Long
Dim Li As Long
Dim py As Long
py = rg.Rows.Count + 2
Li = 2 * rg.Row + rg.Rows.Count + py
Dim r1(), c1(), ri(), ci(), rc(), cc() As Long
i = 1
n = 0
For Each r In rg
If r.Address <> r.MergeArea.Address And r.Address = r.MergeArea.Item(1).Address Then
n = n + 1
ElseIf r.Address = r.MergeArea.Address And r.Address = r.MergeArea.Item(1).Address Then
n = n + 1
End If
Next
ReDim a(1 To n)
ReDim r1(1 To n)
ReDim c1(1 To n)
ReDim ri(1 To n)
ReDim ci(1 To n)
ReDim rc(1 To n)
ReDim cc(1 To n)
ReDim ac(1 To n)
For Each r In rg
If r.Address <> r.MergeArea.Address And r.Address = r.MergeArea.Item(1).Address Then
Set a(i) = r.MergeArea
i = i + 1
ElseIf r.Address = r.MergeArea.Address And r.Address = r.MergeArea.Item(1).Address Then
Set a(i) = r
i = i + 1
End If
Next
For i = 1 To n
r1(i) = a(i).Row
c1(i) = a(i).Column
rc(i) = a(i).Rows.Count
cc(i) = a(i).Columns.Count
ri(i) = r1(i) + rc(i)
ci(i) = c1(i) + cc(i)
If a(i).MergeCells Then
Set ac(i) = Range(Cells(Li - r1(i) - rc(i), c1(i)), Cells(Li - ri(i) + rc(i), ci(i)))
Else
Set ac(i) = Cells(Li - r1(i) - rc(i), c1(i))
End If
a(i).Copy ac(i)
Next i
MsgBox "该选区共有" & n & "个区域。单元格区域镜像成功!", vbInformation
End Sub