处理工作表格，按人、按类型汇总所有行的工作内容

sunya_0529

WPS里的JSA练习一下——

翁知江安

Sub test()
Dim i, j As Integer
Dim ar, br, cr As Variant
Dim d1, d2, d3 As Object
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
ar = Sheets("工作表1").Range("a1:d" & Sheets("工作表1").[a65536].End(xlUp).Row)
For i = 3 To UBound(ar)
    If ar(i, 2) <> "..." Then
       d1(ar(i, 2)) = "": d2(ar(i, 3)) = ""
       If Not d3.exists(ar(i, 2) & ar(i, 3)) Then
           d3(ar(i, 2) & ar(i, 3)) = ar(i, 4)
           Else
           d3(ar(i, 2) & ar(i, 3)) = d3(ar(i, 2) & ar(i, 3)) & "," & ar(i, 4)
        End If
      End If
Next
With Sheets("工作表1")
.[g2].Resize(1 + d1.Count, 1 + d2.Count).ClearContents
.[g3].Resize(d1.Count, 1) = WorksheetFunction.Transpose(d1.keys)
.[h2].Resize(1, d2.Count) = d2.keys
br = .[g2].Resize(1 + d1.Count, 1 + d2.Count)
ReDim cr(1 To d1.Count, 1 To d2.Count)
For i = 2 To d1.Count + 1
   For j = 2 To d2.Count + 1
   cr(i - 1, j - 1) = d3(br(i, 1) & br(1, j))
   Next
Next
.[h3].Resize(d1.Count, d2.Count) = cr
End With
MsgBox "ok"
End Sub

gwjkkkkk

请参考附件。。。

wang-way

1. function main() {
   
2.     // 获取当前工作簿的第一个工作表
   
3.     const sheet = Application.ThisWorkbook.Worksheets.Item(1);
   
4.     // 获取数据区域并去除表头
   
5.     const data = sheet.Range('a1').CurrentRegion.Value2.slice(1);
   
6. 
   
7.     // 提取姓名列并去重
   
8.     const names = [...new Set(data.map(row => row[1]))];
   
9.     // 提取类型列并去重
   
10.     const types = [...new Set(data.map(row => row[2]))];
    
11. 
    
12.     // 提前计算姓名和类型的数量
    
13.     const nameCount = names.length;
    
14.     const typeCount = types.length;
    
15. 
    
16.     // 初始化结果数组，包含表头和空内容
    
17.     const result = [['姓名', ...types], ...Array(nameCount).fill().map(() => Array(typeCount + 1).fill(''))];
    
18. 
    
19.     // 遍历数据并填充结果数组
    
20.     data.forEach(([_, name, type, content]) => {
    
21.         const rowIndex = names.indexOf(name) + 1;
    
22.         const colIndex = types.indexOf(type) + 1;
    
23.         result[rowIndex][0] = name;
    
24.         result[rowIndex][colIndex] = result[rowIndex][colIndex] === ''? content : result[rowIndex][colIndex] + ',' + content;
    
25.     });
    
26. 
    
27.     // 将结果写入工作表
    
28.     sheet.Range('f1').Resize(nameCount + 1, typeCount + 1).Value2 = result;
    
29. }

复制代码

wang-way

1. function 模仿铭佬()
   
2. {
   
3.         let res=Range('A2').CurrentRegion().slice(2).reduce((r,[_,n,t,c])=>
   
4.                 {
   
5.                         let i=r[n]??=r.push([n])-1;
   
6.                         let j=r[t]??=r[0].push(t)-1;
   
7.                         r[i][j]=r[i][j]===undefined?c:r[i][j]+=c;
   
8.                         return r;
   
9.                 },[['姓名']])
   
10.         Range('H1').Resize(res.length,res[0].length).Value2=res;
    
11. }

复制代码

铭佬真是个天才

wang-way

wang-way 发表于 2025-4-7 22:14
铭佬真是个天才

function 模仿铭佬()
{
        let res=Range('A2').CurrentRegion().slice(2).reduce((r,[_,n,t,c])=>
                {
                        let i=r[n]??=r.push([n])-1;
                        let j=r[t]??=r[0].push(t)-1;
                        r[j]=(r[j]||0)+=c;
                        return r;
                },[['姓名']])
        Range('H1').Resize(res.length,res[0].length).Value2=res;
}

袁先生

在工作表1中I3单元格中填上如下公式=TEXTJOIN(",",TRUE,FILTER($D$3:$D$12,($C$3:$C$12=I$2)*($B$3:$B$12=$H3),""))，向右填充，再向下填允