三维表转换

沈默00

沈默00

函数写的累，，VBA比较轻松，凑一个，，放在第二个表格，，

我的城市你来过

=LET(b,DROP(SUBSTITUTE(REDUCE("",$F$2:$J$2,LAMBDA(x,y,VSTACK(x,IFNA(HSTACK(OFFSET(y,-1,)&","&B3:B13,$C$3:$D$13,y,OFFSET(y,ROW($A$1:$A$11),)),y)))),",",""),1),VSTACK({"科目","门店","名称","二级","金额"},HSTACK(SCAN("",TAKE(b,,1),LAMBDA(x,y,IF(y<>"",y,x))),DROP(b,,1))))

zzq0117

我的城市你来过 发表于 2024-8-7 15:06
=LET(b,DROP(SUBSTITUTE(REDUCE("",$F$2:$J$2,LAMBDA(x,y,VSTACK(x,IFNA(HSTACK(OFFSET(y,-1,)&","&B3:B13, ...

老师，这个公式是不是粘贴错了，金额显示为错误

zzq0117

飞天篮球猪 发表于 2024-8-7 10:43

老师，这个公式很新鲜呀，第一次见，能发个能复制的公式吗？那个波浪线都打不出来，谢谢。

zzq0117

无关岁月 发表于 2024-8-7 11:12

老师看看这个有办法吗？

彩鱼儿

vba思路就是 先把金额排好 然后将金额对应的数据放到新表里

1. Sub TransposeAndOrganizeFees()
   
2.     Dim wsSource As Worksheet, wsDest As Worksheet
   
3.     Dim lastRowSource As Long, lastColSource As Long, rowDest As Long
   
4.     Dim colSource As Long, rowSource As Long
   
5.       
   
6.     ' 设置源工作表和目标工作表
   
7.     Set wsSource = ThisWorkbook.Sheets("Sheet2") ' 修改为源数据所在的工作表名
   
8.     Set wsDest = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
   
9.     wsDest.Name = "新表"
   
10.       
    
11.     ' 初始化目标工作表的行号
    
12.     rowDest = 2
    
13.       
    
14.     ' 获取源工作表的最后一行和最后一列
    
15.     lastRowSource = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    
16.     lastColSource = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).column
    
17. 
    
18.     For colSource = 6 To lastColSource + 1
    
19.         Dim feeType As String
    
20.         feeType = wsSource.Cells(2, colSource).Value
    
21.          
    
22.         ' 遍历该列的每一行
    
23.         For rowSource = 3 To lastRowSource
    
24.             ' 将费用类型和对应的值写入新工作表
    
25.             wsDest.Cells(rowDest, 4).Value = feeType
    
26.             If feeType = "工资及奖金" Or feeType = "物业租赁费" Or feeType = "办公费" Then
    
27.                 wsDest.Cells(rowDest, 1) = "销售费用"
    
28.             Else
    
29.                 wsDest.Cells(rowDest, 1) = "管理费用"
    
30.             End If
    
31.             wsDest.Cells(rowDest, 5).Value = wsSource.Cells(rowSource, colSource).Value
    
32.             
    
33.             wsDest.Cells(rowDest, 3).Value = wsSource.Cells(rowSource, 4).Value
    
34.             wsDest.Cells(rowDest, 2).Value = wsSource.Cells(rowSource, 3).Value
    
35.             
    
36.             ' 移动到新工作表的下一行以准备填充下一组数据
    
37.             rowDest = rowDest + 1
    
38.         Next rowSource
    
39.     Next colSource
    
40.       
    
41. End Sub
    

复制代码