Excel单元格数据上下颠倒/镜像(原创)

这是一组使用Excel自带的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