Excel转置公式 [英] Excel transpose formula

问题描述

我已经缠了一段时间了，只是不知道如何解决这个问题.我的表由几组数据组成，我想将这些数据从行转置为列.每行的第一列都有一个索引号，而一组中的所有行都具有相同的索引.

I've been wraping my head around it for some time and just don't know how to approach this problem. My table consists of groups of data which I want to transpose from rows to columns. Every row has an index number in first column and all of the rows in one group have the same index.

1 a
1 b
1 c
1 d
1 e
1 f
1 g
1 h
2 as
2 bs
2 cs
5 ma
5 mb
5 mc
5 md

1 a
1 b
1 c
1 d
1 e
1 f
1 g
1 h
2 as
2 bs
2 cs
5 ma
5 mb
5 mc
5 md

我希望我的最终结果是:

and I want my final result to be:

1 a b c d e f g h
2 as bs cs
5 ma mb mc md

1 a b c d e f g h
2 as bs cs
5 ma mb mc md

是否可以使用公式来执行此操作，或者我必须在VBA中执行此操作?

is it possible to do this with formulas or do I have to do it in VBA?

推荐答案

您也可以使用宏进行此操作.这是一种方法.

You can also do this using a macro. Here is one method.

要输入此宏(子)，请按 alt-F11 打开Visual Basic编辑器. 确保在项目资源管理器"窗口中突出显示您的项目. 然后，从顶部菜单中选择插入/模块"，然后 将下面的代码粘贴到打开的窗口中.

To enter this Macro (Sub), alt-F11 opens the Visual Basic Editor. Ensure your project is highlighted in the Project Explorer window. Then, from the top menu, select Insert/Module and paste the code below into the window that opens.

要使用此宏(子)，请使用 alt-F8 打开宏对话框.按名称选择宏，然后运行.

To use this Macro (Sub), alt-F8 opens the macro dialog box. Select the macro by name, and RUN.

Option Explicit
Sub ReArrange()
    Dim vSrc As Variant, rSrc As Range
    Dim vRes As Variant, rRes As Range
    Dim I As Long, J As Long, K As Long
    Dim lColsCount As Long
    Dim Col As Collection
'Upper left cell of results
Set rRes = Range("D1")

'Assume Data in A1:Bn with no labels
Set rSrc = Range("a1", Cells(Rows.Count, "A").End(xlUp)).Resize(columnsize:=2)

'Ensure Data sorted by index number
rSrc.Sort key1:=rSrc.Columns(1), order1:=xlAscending, key2:=rSrc.Columns(2), order2:=xlAscending, MatchCase:=False, _
    Header:=xlNo

'Read Source data into array for faster processing 
'  compared with going back and forth to worksheet
vSrc = rSrc

'Compute Number of rows = unique count of index numbers
'Collection object can only have one entry per key
'  otherwise it produces an error, which we skip
Set Col = New Collection
On Error Resume Next
For I = 1 To UBound(vSrc)
    Col.Add Item:=vSrc(I, 1), Key:=CStr(vSrc(I, 1))
Next I
On Error GoTo 0

'Compute Maximum Number of columns in results
'  Since there is one entry per Index entry, maximum number of
'  columns will be equal to the Index that has the most lines
'  So we iterate through each Index and check that.
For I = 1 To Col.Count
    J = WorksheetFunction.CountIf(rSrc.Columns(1), Col(I))
    lColsCount = IIf(J > lColsCount, J, lColsCount)
Next I

'Set up Results array
'  Need to add one to the columns to account for the column with the Index labels
ReDim vRes(1 To Col.Count, 1 To lColsCount + 1)

'Now populate the results array
K = 1
For I = 1 To Col.Count
    vRes(I, 1) = vSrc(K, 1)
    J = 2
    Do
        vRes(I, J) = vSrc(K, 2)
        J = J + 1: K = K + 1
        If K > UBound(vSrc) Then Exit Do
    Loop Until vSrc(K, 1) <> vRes(I, 1)
Next I

'Set the results range to be the same size as our array
Set rRes = rRes.Resize(rowsize:=UBound(vRes, 1), columnsize:=UBound(vRes, 2))

'Clear the results range and then copy the results array to it
rRes.EntireColumn.Clear
rRes = vRes

'Format the width.  Could also format other parameters
rRes.EntireColumn.ColumnWidth = 10

End Sub

这篇关于Excel转置公式的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！