我需要一个Excel VBA代码才能将多列表转换为单列表 [英] I need a Excel VBA Code to Convert a Multiple Column Table into a Single Column table

问题描述

输入:Excel表

Data    4/1/2012    4/2/2012    4/3/2012    4/4/2012    4/5/2012
V        10 20  30  40  50
H   5   10  15  20  25
S   6   12  18  24  30
R   8   16  24  32  40
A   9   18  27  36  45

Output : Excel Table
V        4/1/2012    10
V        4/2/2012    20
V        4/3/2012    30
V        4/4/2012    40
V        4/5/2012    50
H        4/1/2012    5
H        4/2/2012    10
H        4/3/2012    15
H        4/4/2012    20
H        4/5/2012    25
.
.
.
A        4/1/2012    9
A        4/2/2012    18
A        4/3/2012    27
A        4/4/2012    36
A        4/5/2012    45

推荐答案

这里是使用 Arrays 的解决方案.在代码中，有几个 static 范围.因此，您将需要设置工作表名称，并相应地开始单元格名称.

Here is a solution using Arrays. In the code, there are couple of static ranges. So you will need to set the sheet name, starting cell names accordingly.

Option Explicit

Sub colsToRows()
Dim ws1 As Worksheet
Dim a As Long, lr As Long, lc As Long
Dim va As Variant, vd As Variant
Dim LastRow As Long, LastCol As Long

        '-- set e.g. sheet name Sheet1, starting column = B, dates starting cell = C2
        Set ws1 = Sheets("Sheet1")
        LastRow = ws1.Range("B" & ws1.Rows.Count).End(xlUp).Row
        LastCol = ws1.Cells(Range("C2").Row, ws1.Columns.Count).End(xlToLeft).Column - 1

        '--put dates into this array as it repeats for each item
        vd = WorksheetFunction.Transpose(WorksheetFunction.Transpose(ws1.Range("C2").Resize(1, LastCol - 1)))

        '-- titles
        ws1.Range("B2").Offset(LastRow + 1) = "Item"
        ws1.Range("C2").Offset(LastRow + 1) = "Dates"
        ws1.Range("D2").Offset(LastRow + 1) = "Data"

        '--2 is deducted as the main range is starting from B3. So B3-B1 = 2
        For a = 1 To LastRow - 2
           '--to get next last row
            lr = Cells(Rows.Count, "B").End(xlUp).Row

            '--items
            va = Array(ws1.Range("B2").Offset(a).Value)
            ws1.Range("B1").Offset(lr).Resize(LastCol - 1) = Application.Transpose(va)

            '--dates
            ws1.Range("C1").Offset(lr).Resize(UBound(vd)) = Application.Transpose(vd)

            '--data
            va = WorksheetFunction.Transpose(WorksheetFunction.Transpose(ws1.Range("C2").Offset(a).Resize(1, LastCol - 1)))
            ws1.Range("D1").Offset(lr).Resize(UBound(va)) = Application.Transpose(va)
        Next a

End Sub

输出:

这篇关于我需要一个Excel VBA代码才能将多列表转换为单列表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！