指定位置插入空白行问题

奋斗000

求大神写一段vba代码，实现在指定位置插入空白行并写入相关信息。具体请看附件

LIUZHU

插入空白行，输入考场号，但是考场号怎么还对应学号？

LIUZHU

请问，这个学号看起来就是序号，是要添加的新内容吗？

LIUZHU

是这个效果吗？就剩没有将颜色标红了

LIUZHU

JSA代码，WPS可以测试

1. function 整理数据(){
   
2.         let sh=Sheets.Item("Sheet0");
   
3.         let obj=sh.Range("i2").CurrentRegion.Value2.slice(1).reduce((dic,[a,b])=>(dic[b.slice(0,9)]=a,dic),{});
   
4.         let k=0,arr=sh.Range("a1").CurrentRegion.Value2;
   
5.         let res=arr.slice(1).reduce((res,[a,b,c,d])=>{
   
6.                 if (c in obj) res.push([,obj[c],,,++k]);
   
7.                 return (res.push([a,b,c,d,++k]),res);
   
8.         },[arr[0]]);
   
9.         Sheets.Item("效果").Activate();
   
10.         Range("a1").Resize(res.length,res[0].length).Value2=res;
    
11. }

复制代码

LIUZHU

附件在此，WPS测试

奋斗000

LIUZHU 发表于 2024-4-23 19:06
附件在此，WPS测试

就是这样的。这个主要是打印条形码用。每次都要打印上千个条码，打印好了还要对应考场起止号裁剪开，按顺序摆到相应考场，实现我想要的结果后，不需要再看起止号了，，就能很方便的看出来从哪里裁剪。另外，麻烦将最终效果直接在原表呈现，不需要将结果放在新表中。谢谢。

swl4561255

1. Sub test()
   
2. Application.ScreenUpdating = False
   
3. ar = [A1].End(4).Row
   
4. arr = [I2].CurrentRegion
   
5. For i = 2 To UBound(arr)
   
6.     For j = ar To 2 Step -1
   
7.         If Cells(j, 3) = Val(Split(arr(i, 2), "-")(0)) Then
   
8.             Range(Cells(j, "A"), Cells(j, "E")).Insert shift:=xlDown
   
9.             Cells(j, "B") = arr(i, 1)
   
10.         End If
    
11.     Next
    
12. Next
    
13. Dim brr(1 To 1000, 1 To 1)
    
14. br = [B1].End(4).Row
    
15. For k = 1 To br - 1
    
16.     brr(k, 1) = k
    
17. Next
    
18. [E2].Resize(UBound(brr), 1) = brr
    
19. Application.ScreenUpdating = False
    
20. End Sub
    

复制代码

奋斗000

LIUZHU 发表于 2024-4-23 19:05
是这个效果吗？就剩没有将颜色标红了

不用标红。请用vba代码吧，我的电脑打开什么代码都看不到

cnmlgb9998

简单。。。。。。。。。。。。。。。。。。。。。。