Excel | VBA | 二维转一维 | 横向排列转纵向排列

新的一年，各种目标拆解，格式还都不统一，手工转换太麻烦，整一个自动二维转一维的模板。

吐槽：原来已有一个别人做的自动转换模板，今年用着不方便，想优化一下，打开VB一看，竟然设置了密码保护，就比较无语，还是自己动手吧，随时想用都可以调用。

---

将 Excel 表格二维转一维，还是有很多方法的，比如Power Query、数据透视表、动态数组等，每个都有不同情境下便捷适用的时候，只不过我个人偏向使用VBA宏。建好模板后，一键自动化，随机变动，没有那么多条件限制。

若是Excel还未开通宏权限，则需先操作启用宏。操作如下：

1.文件->选项->自定义功能区->勾选“开发工具”（旧版本工具栏默认未勾选，新手动增加）

2.工具栏->开发工具->宏安全性->宏设置->启用所有宏

若是已有宏权限，则不需要操作上面步骤，直接操作：

1.开发工具->打开VB->复制代码

2.定义“转换前”、“转换后”两个Sheet

3.“转换前”表单->开发工具->插入->表单控件（按钮）->引用宏“二维转一维”

Sub 二维转一维()

    '清除"转换后"表格内容

    Sheets("转换后").Select

    Cells.Select

    Selection.Clear

    Sheets("转换前").Select

    Dim i%, j%

    On Error Resume Next

    Application.InputBox(prompt:="请选择要转换区域： 如B1:M200", Type:=8).Select

    '随机选择要转换的区域，需含转换维度表头，如月度2026-01

    With Selection

    r = .Row

    c = .Column

    rs = .Rows.Count

    cs = .Columns.Count

    End With

    Sheets("转换前").Range(Cells(r, 1), Cells(r, c - 1)).Copy

    Sheets("转换后").Range("A1").PasteSpecial Paste:=xlPasteAll

    n = 2

    For i = 0 To cs - 1

        Sheets("转换前").Range(Cells(r + 1, 1), Cells(r + rs - 1, c - 1)).Copy

        Sheets("转换后").Cells(n, 1).PasteSpecial Paste:=xlPasteAll

        For j = n To n + rs - 2

            Sheets("转换后").Cells(j, c) = Sheets("转换前").Cells(r, c + i)

        Next

        Sheets("转换前").Range(Cells(r + 1, c + i), Cells(r + rs - 1, c + i)).Copy

        Sheets("转换后").Cells(n, c + 1).PasteSpecial Paste:=xlPasteAll

        n = n + rs - 1

    Next

    Sheets("转换后").Select

    Cells(1, c) = "转换维"

    Cells(1, c + 1) = "数据"

    Range("A1").Select

End Sub

后台回复“二维转一维”获取模板下载链接。