如何让同一人多行多列数据合并成一行呢？

506981919

一招秒杀 发表于 2025-2-15 22:03
简单1旬搞定

大侠，请问这是什么软件或功能做出来的呢？

taller

1. ' 可以合并多个内容
   
2. Sub Demo()
   
3.     Dim objDic As Object, rngData As Range
   
4.     Dim i As Long, j As Long, sKey, aRow()
   
5.     Dim arrData, arrRes
   
6.     Set objDic = CreateObject("scripting.dictionary")
   
7.     Set rngData = Range("A1").CurrentRegion
   
8.     arrData = rngData.Value
   
9.     Dim ColCnt As Long: ColCnt = UBound(arrData, 2)
   
10.     For i = LBound(arrData) + 1 To UBound(arrData)
    
11.         sKey = arrData(i, 1)
    
12.         If Not objDic.exists(sKey) Then
    
13.             ReDim aRow(1 To ColCnt - 1)
    
14.             objDic(sKey) = aRow
    
15.         End If
    
16.         aRow = objDic(sKey)
    
17.         For j = 2 To ColCnt
    
18.             If Len(arrData(i, j)) > 0 Then
    
19.                 If Len(aRow(j - 1)) = 0 Then
    
20.                     aRow(j - 1) = arrData(i, j)
    
21.                 Else
    
22.                     aRow(j - 1) = aRow(j - 1) & "," & arrData(i, j)
    
23.                 End If
    
24.             End If
    
25.         Next
    
26.         objDic(sKey) = aRow
    
27.     Next i
    
28.     ReDim arrRes(1 To objDic.Count + 1, 1 To ColCnt)
    
29.     For j = 1 To ColCnt
    
30.         arrRes(1, j) = arrData(1, j)
    
31.     Next
    
32.     i = 1
    
33.     For Each sKey In objDic.keys
    
34.         i = i + 1
    
35.         arrRes(i, 1) = sKey
    
36.         aRow = objDic(sKey)
    
37.         For j = 2 To ColCnt
    
38.             arrRes(i, j) = aRow(j - 1)
    
39.         Next
    
40.     Next
    
41.     Range("P1").Resize(UBound(arrRes), ColCnt).Value = arrRes
    
42. End Sub
    

复制代码

ykcbf1100

参与一下，字典排重合并

ykcbf1100

1. Sub ykcbf()    '//2025.2.16
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     arr = [a2].CurrentRegion
   
4.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
5.     For i = 2 To UBound(arr)
   
6.         s = arr(i, 1)
   
7.         If s <> Empty Then
   
8.             If Not d.exists(s) Then
   
9.                 m = m + 1
   
10.                 d(s) = m
    
11.                 For j = 1 To UBound(arr, 2)
    
12.                     brr(m, j) = arr(i, j)
    
13.                 Next
    
14.             Else
    
15.                 r = d(s)
    
16.                 For j = 2 To UBound(arr, 2)
    
17.                     brr(r, j) = brr(r, j) & arr(i, j)
    
18.                 Next
    
19.             End If
    
20.         End If
    
21.     Next
    
22.     [i8].Resize(m, UBound(arr, 2)) = brr
    
23.     MsgBox "OK！"
    
24. End Sub
    

复制代码

lizhipei78

还是比较简易的题目，练习一下

cjc209

js自定义函数一句搞定

lizhipei78

今铭昔 发表于 2025-2-15 15:54

v.forEach(fun,r[a])，这一句看不懂得呀，v通过函数返回新的v，而r[a]跟v存在什么关系呢？

lizhipei78

不用bind

493861364

PQ解法                     

lhm667788

在PQ中用逆透视和透视两步就可解决(姓名列写上列标题"姓名"):
let
    源数据 = Excel.CurrentWorkbook(){[Name="表1"]}[Content],
    逆透视数据 = Table.UnpivotOtherColumns(源数据, {"姓名"}, "属性", "值"),
    透视数据 = Table.Pivot(逆透视数据, List.Distinct(逆透视数据[属性]), "属性", "值")
in
    透视数据