求助各位大佬，看如何解决？

两个表格，如何才能从表1实现表2的效果，因为数据有几千条，如果手工要累死。谢谢各位！

PQ方法供参考

let
源 = Excel.CurrentWorkbook(){[Name="表1"]}[Content],
更改的类型 = Table.TransformColumnTypes(源,{{"账号", type text}}),
分组 = Table.Group(更改的类型, "账号", {"明细", (x)=> List.Combine( List.Transform( Table.ToRows(x), each List.LastN(_,3)))}),
重构 = Table.FromColumns(分组[明细],分组[账号] ),
已添加索引 = Table.AddIndexColumn(重构, "索引", 0, 1, Int64.Type),
表头 = List.LastN( Table.ColumnNames(更改的类型),3),
加表头 = Table.AddColumn( 已添加索引, "账号", each 表头{Number.Mod([索引],3)} & Text.From(Number.IntegerDivide([索引],3)+1)),
删除的列 = Table.RemoveColumns(加表头,{"索引"}),
降级的标题 = Table.DemoteHeaders(删除的列),
重排序的列 = Table.ReorderColumns(降级的标题,{"Column4", "Column1", "Column2", "Column3"}),
转置表 = Table.Transpose(重排序的列),
提升的标题 = Table.PromoteHeaders(转置表)
in
提升的标题

index+smaal金典万精油公式

'假设A列有序，如果无序先手工排序或者用字典来处理
Option Explicit
Sub 转置()
　Dim a, i, j, m, n, max
　a = [a1].CurrentRegion.Offset(1).Resize(, 4).Value
　ReDim b(1 To UBound(a) / 2, 3 * 80) '输出最多支持241列，如果列不够修改
　For i = 1 To UBound(a, 1) - 1
　　For j = 2 To 4
　　　n = n + 1
　　　b(m + 1, n) = a(i, j)
　　　If max < n Then max = n
　　Next
　　If a(i, 1) <> a(i + 1, 1) Then m = m + 1: n = 0: b(m, 0) = a(i, 1)
　Next
　[f2].Resize(m, max + 4) = b
End Sub

写宏的话，我大概会这么做：
首先把账号复制到横列的账号列，然后去除重复值
然后大循环这个横账号列套小循环竖账号列，相同账号就把值复制到横列

用公式的话，排序后加index+lookup也快
感觉不用那么复杂，不过没电脑在手哈哈，大概给个思路

我哪是要去掉重复帐号这么简单，

Sub hbl()
[f2:AA1000].ClearContents
n = [a65535].End(xlUp).Row
Cells(2, "F") = Cells(2, "A")
k = 2
For i = 2 To n
found = 0
For j = 2 To k
If Cells(i, "A") = Cells(j, "F") Then
found = 1
Exit For
End If
Next j
If found = 0 Then
k = k + 1
Cells(k, "F") = Cells(i, "A")
End If
Next i
For i = 2 To k
For j = 2 To n
If Cells(j, "A") = Cells(i, "F") Then
For j2 = 7 To 1000
If Cells(i, j2) = "" Then
Cells(i, j2) = Cells(j, "B")
Cells(i, j2 + 1) = Cells(j, "C")
Cells(i, j2 + 2) = Cells(j, "D")
Exit For
End If
Next j2
End If
Next j
Next i
End Sub

这样具唯一特性的数据，用字典呀

没看明图1的999 C 和图2的999 B

'如果A列无序那就用字典，代码会啰嗦一点的
Option Explicit
Sub 转置()
　Dim a, i, j, n, max, d
　a = [a1].CurrentRegion.Offset(1).Resize(, 4).Value
　Set d = CreateObject("scripting.dictionary")
　ReDim b(1 To UBound(a) / 2, 3 * 80), m(UBound(a))
　For i = 1 To UBound(a, 1)
　　If Not d.exists(a(i, 1)) Then
　　　n = n + 1: d(a(i, 1)) = n: b(n, 0) = a(i, 1)
　　End If
　　m(d(a(i, 1))) = m(d(a(i, 1))) + 3
　　If max < m(d(a(i, 1))) Then max = m(d(a(i, 1)))
　　For j = 2 To 4
　　　b(d(a(i, 1)), m(d(a(i, 1))) + j - 4) = a(i, j)
　　Next
　Next
　[f2].Resize(n, max + 4) = b
End Sub

扫二维码下载贴吧客户端

下载贴吧APP
看高清直播、视频！

27回复贴，共1页

<<返回excel吧

分享到:

日	一	二	三	四	五	六