如何用VBA代码，实现一维表转换成二维表

LIUZHU

参与下，难度不大

LIUZHU

JS代码，供参考

1. function 转换(){
   
2.         let res=Range("a1").CurrentRegion.Value2.slice(1).reduce((res,[a,b,c])=>{
   
3.                 if (!res[0].includes(a)) res[0].push(a);
   
4.                 let n=res[0].indexOf(a);
   
5.                 let temp=res[b]=res[b] || (res[res.length]=[b]);
   
6.                 return temp[n]=(temp[n] || 0) + c, res;
   
7.         },[["区域"]]);
   
8.         Range("h1").Resize(res.length, res[0].length).Value2=res;
   
9.         Range("h1").CurrentRegion.Borders.LineStyle=1;
   
10. }

复制代码

LIUZHU

附件，WPS打开测试

边缘码农

分类求和，用公式，应该行。

边缘码农

只是需要每次维护表格的第一行和第一列，不如代码便捷。

Qs18

Sub qs() '2024/6/28透视法
    Application.ScreenUpdating = False
    Sheet1.Range("s:z").Clear
    Dim hc As PivotCache '定义缓存
    Dim ts As PivotTable '定义透视表
    ar = Sheet1.Range("b1") '行标签可用数组
    Set hc = ThisWorkbook.PivotCaches.Create(xlDatabase, Sheet1.Range("a1").CurrentRegion, 4)
    Set ts = hc.CreatePivotTable(Sheets("Sheet1").[s1], "表1", True, 4)
    With ts
        .AddFields ar, "产品" '.AddFields ar, "评级"(ar为行字段，评级为列地段)
        .AddDataField .PivotFields("金额"), "金额求和", xlSum
        .ColumnGrand = False '列禁用合计
        .RowGrand = False '行禁用合计
        .RowAxisLayout xlTabularRow '经典布局
    End With
    Range("S2:Z1800").Copy
    Range("H1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheet1.Range("s:z").Clear
    Application.ScreenUpdating = True
End Sub

Qs18

试试.................

Qs18

试试................

wang-way

wang-way

LIUZHU 发表于 2024-6-28 09:32
JS代码，供参考

第3行 push 返回n 对不对  第4行可以省