为了去避免近似同姓名（姓名最后两个字相同）分到同一班级，请大神帮忙用VBA提取这...

qqyyh

gwjkkkkk 发表于 2024-3-31 17:57
请参考附件。。。

谢谢大神！正是我要的。

qqyyh

清风竹- 发表于 2024-3-31 17:57
请看附件。

谢谢大神！！！

山菊花

同名不同姓，只要读音有区别，分在同一班影响不大，影响大的是姓名都同音，如张志伟与章志炜、林利与林丽。

qqyyh

山菊花 发表于 2024-4-1 07:46
同名不同姓，只要读音有区别，分在同一班影响不大，影响大的是姓名都同音，如张志伟与章志炜、林利与林丽。

赞同！！！！！！

LIUZHU

就提取相似姓名和相同姓名，JSA参与下

1. function 近似同名1(){
   
2.         let arr=Sheets.Item("Sheet1").Range("b2:p201").Value2;
   
3.         let obj=arr.reduce((dic,x)=>{
   
4.                 let key=x[1].slice(-2);
   
5.                 return ((dic[key]=dic[key] || []).push(x),dic);
   
6.         },{});
   
7.         for (let key in obj) obj[key].length==1?delete(obj[key]):null;
   
8.         let res=Object.values(obj).flat();
   
9.         Sheets.Item("Sheet1").Copy(null,Sheets("Sheet1"));
   
10.         ActiveSheet.Name="提取结果1";
    
11.         Range("b2").Resize(res.length,res[0].length).Value2=res;
    
12.         Range(`${res.length+2}:${arr.length+1}`).Delete();
    
13. }

复制代码

LIUZHU

方法二，代码更简单

1. function 近似同名2(){
   
2.         let arr=Sheets.Item("Sheet1").Range("b2:p201").Value2;
   
3.         arr.sort((a,b)=>a[1].slice(-2).localeCompare(b[1].slice(-2)));                //按姓名最后两个字排序
   
4.         let res=arr.map(x=>x[1].slice(-2)).reduce((res,y,i,ar)=>(ar.indexOf(y)!=ar.lastIndexOf(y)?res.push(arr[i]):null,res),[]);
   
5.         Sheets.Item("Sheet1").Copy(null,Sheets("Sheet1"));
   
6.         ActiveSheet.Name="提取结果2";
   
7.         Range("b2").Resize(res.length,res[0].length).Value2=res;
   
8.         Range(`${res.length+2}:${arr.length+1}`).Delete();
   
9. }

复制代码

LIUZHU

附件，WPS测试即可

qqyyh

LIUZHU 发表于 2024-4-1 14:17
附件，WPS测试即可

WPS中查不到代码，不知道怎样运行？

LIUZHU

qqyyh 发表于 2024-4-2 09:08
WPS中查不到代码，不知道怎样运行？

安装最新版的WPS，在JS宏中查看

qqyyh

gwjkkkkk 发表于 2024-3-31 17:57
请参考附件。。。

再问大神，能这些近似同姓名复制到另一个工作簿吗？第一行的标题（姓名，编号……）不用复制过来。谢谢！