求助：JSA或者VBA将一维转三维

lizhipei78

Again123456 发表于 2025-1-1 20:02
0列肯定是有的！你都没仔细看

能把代码发上来，我学习一下，我觉得你写的比较简单，其它大神写的看不懂得

Again123456

我的思路比较简单，直接写数组

Again123456

lizhipei78 发表于 2025-1-1 20:07
能把代码发上来，我学习一下，我觉得你写的比较简单，其它大神写的看不懂得

上面33 楼上传了附件的，不过后面的链接，没看到需求

Again123456

1. function  test(){//本方法为直接写数组元素法
   
2.         let data = Sheets('区').Range('a2').CurrentRegion().slice(1)//原始数据已按类型排序，就不写排序了
   
3.         let startRow//每一种类型起始行
   
4.         let res = data.reduce((p,[sn,name,type,count]) => {
   
5.                 let col = count + 1//要写入的列
   
6.                 p[0][col] = count  //写入列标题
   
7.                 startRow = p[type] ??= p.push([type]) -1 //第一次出现该类型为起始行
   
8.                 let row = startRow
   
9.                 while(p[row][col]){//如果当前行列有数据，往下找空白行
   
10.                         row == p.length - 1 && p.push([type])//如果当前行是结果数组的最后一行，则压入新行
    
11.                         row ++
    
12.                 }
    
13.                 p[row][col] = sn + name//写对应行列的值
    
14.                 return p               
    
15.         },[['类别']])//结果初始值就一个单元格
    
16.         let sht = Sheets('区三维')
    
17.         sht.UsedRange.Clear()
    
18.         sht.Range('a1').Resize(res.length , res[0].length).Value2 = res
    
19.         sht.UsedRange.Columns(1).RangeEx.MergeSame()
    
20.         sht.UsedRange.Borders.LineStyle = xlContinuous
    
21. }

复制代码

金牌1

Again123456 发表于 2025-1-1 20:02
0列肯定是有的！你都没仔细看

感谢老师解答！！！不好意思，当时从截屏上没有仔细观察。确实有0数据所在的列。

一江春水1688

Again123456 发表于 2025-1-1 17:21
不知道结果是否正确

A佬牛，结果正确！一个reduce搞定
A佬把首行、首列冻结了，贴图时把0列【移出】视线，难怪会以为没有0列

金牌1

一江春水1688 发表于 2025-1-1 20:57
A佬牛，结果正确！一个reduce搞定
A佬把首行、首列冻结了，贴图时把0列【移出】视线，难怪会以为没有0列 ...

这真是热闹呀！！！  一江春水1688 的作品美不胜收！！！
在次烦请：神手修改成 数字列降序就更直观大方了！！！

Again123456

一江春水1688 发表于 2025-1-1 20:57
A佬牛，结果正确！一个reduce搞定
A佬把首行、首列冻结了，贴图时把0列【移出】视线，难怪会以为没有0列 ...

超级链接也搞了一个，格式就不搞了


JSA和VBA一维转三维.rar (56.11 KB, 下载次数: 11)

2025-1-1 22:07 上传

点击文件名下载附件

一江春水1688

金牌1 发表于 2025-1-1 21:25
这真是热闹呀！！！  一江春水1688  的作品美不胜收！！！
在次烦请：神手修改成 数字列降序就更直观 ...

一江春水1688

一江春水1688 发表于 2025-1-1 22:13

1. function test7(){
   
2.     Sheets('区').Activate();
   
3.     let rngs = [...Range('A3').CurrentRegion.Columns(2).Cells].slice(1);
   
4.     let arr = Range('A3').CurrentRegion().slice(1);
   
5.     let max = 0;
   
6.     arr.forEach(([,,,d]) => max = Math.max(max, d));
   
7.     let dic = arr.reduce((x, [a, b, c, d], j) => {
   
8.         let dic = x[c] ??= {l:[], r:{}, a:[]};
   
9.         let i = dic.r[d] ??= 0;
   
10.         (dic.l[i] ??= [c])[max - d + 1] = a + b;
    
11.         dic.a.push([rngs[j], i + 1, max - d + 2])
    
12.         return ++dic.r[d], x;
    
13.     }, {});
    
14.     let res = [['类别'].concat([...Array(max+1).keys()].map(x => max-x))];
    
15.     Object.keys(dic).forEach(x => res.push(...dic[x].l));
    
16.     Range('G2').CurrentRegion.Clear();
    
17.     let rng = Range('G2').Resize(res.length, res[0].length);
    
18.     rng.Value2 = res;
    
19.     let iOffset = 1;
    
20.     for(let t in dic){//复制【名字】列的单元格格式
    
21.         dic[t].a.forEach(([s, i, j]) => {
    
22.             if(s.Hyperlinks.Count > 0)  //如果有超链接则复制
    
23.                 ActiveSheet.Hyperlinks.Add(
    
24.                     rng.Cells(i+iOffset, j), s.Hyperlinks(1).Address )
    
25.             s.Copy();
    
26.             rng.Cells(i+iOffset, j).PasteSpecial(xlPasteFormats);
    
27.         })
    
28.         iOffset += dic[t].l.length;
    
29.     }
    
30.     Application.CutCopyMode = false;
    
31.     rng.Columns(1).RangeEx.MergeSame();//同类自动合并单元格
    
32.     rng.Borders.LineStyle = 9;
    
33. }

复制代码