表格转换

APPLE123

表1由系统复制黏贴而成，需转换为表2格式。麻烦各位老师帮忙看看，vba如何实现一键转换。谢谢！

cyq4896

Sub test()
    arr = Sheet1.[a1].CurrentRegion
    ReDim brr(1 To UBound(arr) / 8 + 1, 1 To 8)
    For i = 1 To UBound(arr) Step 8
        n = n + 1
        For k = 1 To 8
            brr(n, k) = arr(i + k - 1, 1)
        Next
    Next
    With Sheet3
        .Cells.Clear
        .Columns("c:e").NumberFormatLocal = "@"
        .[a1] = "xx花名册"
        .[a2].Resize(n, 8) = brr
        .[a2].Resize(n, 8).Borders.LineStyle = 1
    End With
End Sub

cyq4896

参与一下...

taller

quqiyuan

参与一下

LIUZHU

关于这个问题，我记得最新版的Excel365或者最新版的WPS表格有一个折叠函数，可以实现

LIUZHU

参与下，这个效果

LIUZHU

JSA代码，供参考

1. function 转换(){
   
2.         let arr=Sheets.Item("Sheet1").Range("a1").CurrentRegion.Value2;
   
3.         let res=[["xx花名册"],["序号","姓名","证号","单位","代码","年份","备注1","备注2"]];
   
4.         for (let i=0;i<arr.length;i+=8){
   
5.                 res.push(res[1].map((x,j)=>arr[i+j][0]));
   
6.         }
   
7.         Sheets.Item("转换后").Activate();
   
8.         Range("a1").Resize(1,res[1].length).Merge(),Range("a1").HorizontalAlignment=xlCenter;
   
9.         let rng1=Range("a1").Resize(res.length,res[1].length);
   
10.         let rng2=rng1.Rows(`2:${rng1.Rows.Count}`);
    
11.         [rng1.NumberFormatLocal,rng1.Value2]=["@",res];
    
12.         rng1.EntireColumn.AutoFit();
    
13.         [rng2.Borders.LineStyle,rng2.HorizontalAlignment]=[1,xlLeft];
    
14. }

复制代码

LIUZHU

附件，用WPS2019版打开测试，运行JS宏

APPLE123

感谢各位老师的帮助，很好用