将分支电缆导入到电缆标牌表中

ykcbf1100

◆华佗◆ 发表于 2024-9-17 09:05
能否帮忙生成一式二份？

一式二份，你试一下。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.9.17
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     With Sheets("分支电缆")
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         arr = .[b1].Resize(r, 4)
   
7.     End With
   
8.     Set Rng = Sheets("模板").Rows("1:5")
   
9.     ReDim brr(1 To r, 1 To 4)
   
10.     For i = 3 To UBound(arr)
    
11.         If arr(i, 1) <> Empty Then
    
12.             n = n + 1
    
13.             For j = 1 To UBound(arr, 2)
    
14.                 brr(n, j) = arr(i, j)
    
15.             Next
    
16.         End If
    
17.     Next
    
18.     m = 1
    
19.     On Error Resume Next
    
20.     With Sheets("电缆标牌")
    
21.         .Cells.ClearContents
    
22.         For i = 1 To n Step 2
    
23.         Rng.Copy .Cells(m, 1)
    
24.             For x = 1 To 2
    
25.                 For j = 1 To UBound(brr, 2)
    
26.                     .Cells(m + j, 2 + (2 * x - 2) * 3) = brr(i + x - 1, j)
    
27.                     .Cells(m + j, 2 + (2 * x - 1) * 3) = brr(i + x - 1, j)
    
28.                 Next
    
29.             Next
    
30.             m = m + 5
    
31.         Next
    
32.     End With
    
33.     Set Rng = Nothing
    
34.     Application.ScreenUpdating = True
    
35.     MsgBox "OK！"
    
36. End Sub
    

复制代码