Excel转置公式

Question

我一直在围着它讨好一段时间，只是不知道如何解决这个问题。我的表由我想要从行转换为列的数据组组成。每行在第一列中都有一个索引号，并且一个组中的所有行都具有相同的索引。

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 b c d e f g h
2 as bs cs
5 ma mb mc md

是否可以使用公式执行此操作，还是必须在VBA中执行此操作？

Answer 1

是的，可能。您需要以下功能：

1. IF
2. MATCH
3. ISNA
4. INDEX

假设您在表A和B中有数据：



<强> C1：

将值“1”放在单元格C1中

<强> C2：

= C1 + 1

根据需要向下拖动

<强> D1

=MATCH(C1,A:A, 0)

向下拖动单元格C2

<强> E1

=MATCH(C1,A:A, 1)

向下拖动单元格C2

第2页

现在将以下公式放在sheet2的单元格A1中：

=IF(ISNA(Sheet1!$D1), "", IF(Sheet1!$D1="", "", IF(COLUMN()-1+Sheet1!$D1 <=Sheet1!$E1, INDEX(Sheet1!$B:$B, COLUMN()-1+Sheet1!$D1), "")))

根据需要将其拖动/复制到尽可能多的单元格：



结果：



我的博客上还有一篇关于INDEX功能的文章。它可能有用Excel INDEX Function。

您也可以下载完整的文件here。

Answer 2

您也可以使用宏来执行此操作。这是一种方法。

要输入此宏（子）， alt-F11 将打开Visual Basic编辑器。 确保在Project Explorer窗口中突出显示您的项目。 然后，从顶部菜单中选择“插入/模块” 将下面的代码粘贴到打开的窗口中。

要使用此宏（子）， alt-F8 将打开宏对话框。按名称选择宏，然后运行。

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