汇总药品名称

prowl

ykcbf1100 发表于 2024-6-4 20:30
那就这样吧。

还想请教一下，我还有若干个工作簿，每个工作簿的情况和这个例子几乎一样（有的工作表内容数量不一样），老师的代码用到另外的工作簿却不能用。
调试显示这行问题
Set sh = ThisWorkbook.Sheets("汇总表")
老师，我该如何修改

ykcbf1100

prowl 发表于 2024-6-4 21:39
还想请教一下，我还有若干个工作簿，每个工作簿的情况和这个例子几乎一样（有的工作表内容数量不一样）， ...

把其它工作簿中汇总表的名称都改成“汇总表”

LIUZHU

参与下，也是认为增加了一张汇总表，当然也可以由代码增加这张表，如果需要成批处理这种工作簿的话

LIUZHU

JSA代码

1. function 汇总表(){
   
2.         let obj=[...Sheets].reduce((obj,sh)=>{
   
3.                 if (sh.Range("a2").Value2!="序号") return obj;
   
4.                 let key=sh.Range("a1").Value2 || sh.Name;
   
5.                 let temp=obj[key]=[[,],[key],["序号","药品通用名","英文名称","其他名称"]];
   
6.                 sh.UsedRange.Value2.forEach(([a,b,c,d])=>{
   
7.                         if (a==null || typeof(a)=="string") return;
   
8.                         temp.push([temp.length-2,b,c,d]);
   
9.                 });
   
10.                 return obj;
    
11.         },{});
    
12.         let res=Object.values(obj).flat();
    
13.         Sheets.Item("药物汇总表").Range("a1").Resize(res.length,4).Value2=res;
    
14.         Sheets.Item("药物汇总表").Range("1:1").Delete();
    
15. }

复制代码

LIUZHU

附件，WPS打开，运行JS宏即可

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br, i&, j&, r&, n&, wks As Worksheet
   
    ReDim ar(1 To 10 ^ 4, 1 To 4)
    With Worksheets("汇总表")
        For Each wks In Worksheets
            If wks.Name <> .Name Then
                n = n + 1
                If n <> 1 Then r = r + 1
                br = wks.[A1].CurrentRegion.Value
                For i = 1 To 2 'UBound(ar)
                    r = r + 1
                    For j = 1 To 4
                        ar(r, j) = br(i, j)
                    Next j
                Next i
                For i = 4 To UBound(br)
                    r = r + 1
                    For j = 1 To 4
                        ar(r, j) = br(i, j)
                    Next j
                Next i
            End If
        Next
        .Cells.Clear
        .[A1].Resize(r, 4) = ar
    End With
    Beep
End Sub

gwjkkkkk

..............

prowl

gwjkkkkk 发表于 2024-6-5 20:00
..............

多谢多谢老师费心了

prowl

LIUZHU 发表于 2024-6-5 18:35
参与下，也是认为增加了一张汇总表，当然也可以由代码增加这张表，如果需要成批处理这种工作簿的话

感谢老师提供帮助

prowl

LIUZHU 发表于 2024-6-5 18:38
附件，WPS打开，运行JS宏即可

我是office的，老师的代码好像用不了。不过还是要感谢老师的帮助