根据项目名 将变量复制给套数列向下填充

ykcbf1100

设个参数表

1. Sub ykcbf()    '//2024.9.3
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Set d1 = CreateObject("Scripting.Dictionary")
   
4.     arr = Sheets("参数表").UsedRange
   
5.     For i = 2 To UBound(arr)
   
6.         s = arr(i, 1)
   
7.         d1(s) = arr(i, 2)
   
8.     Next
   
9.     Dim zrr(1 To 1000)
   
10.     With Sheets("尾单")
    
11.         r = .Cells(Rows.Count, 1).End(3).Row
    
12.         arr = .[a1].Resize(r, 23)
    
13.         For i = 6 To UBound(arr)
    
14.             s = arr(i, 1)
    
15.             If Not d.exists(s) Then d(s) = i
    
16.         Next
    
17.         k = d.keys: t = d.items
    
18.         For x = 0 To d.Count - 1
    
19.             r1 = t(x)
    
20.             If x = d.Count - 1 Then r2 = r Else r2 = t(x + 1) - 1
    
21.             n = r2 - r1 + 1
    
22.             .Cells(r1, "q") = d1(k(x))
    
23.             st = .Cells(r1, "q")
    
24.             .Cells(r1, "q").Resize(n).Value = st
    
25.         Next
    
26.         MsgBox "OK！"
    
27.     End With
    
28. End Sub
    

复制代码

zhangmy66

ykcbf1100 发表于 2024-9-3 21:00
附件供参考。。。

参数表项目名 能给个读取操作边项目名的代码吗 ，我点击会读取操作表项名名去重后的代码

ykcbf1100

zhangmy66 发表于 2024-9-4 13:27
参数表项目名 能给个读取操作边项目名的代码吗 ，我点击会读取操作表项名名去重后的代码

项目名写入参数表

ykcbf1100

。。。。。。。。。。。

1. Sub ykcbf2()   '//2024.9.4
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     ReDim brr(1 To 1000, 1 To 1)
   
4.     With Sheets("尾单")
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         arr = .[a1].Resize(r, 23)
   
7.         For i = 6 To UBound(arr)
   
8.             s = arr(i, 1)
   
9.             If Not d.exists(s) Then
   
10.                 m = m + 1
    
11.                 d(s) = m
    
12.                 brr(m, 1) = s
    
13.             End If
    
14.         Next
    
15.     End With
    
16.     With Sheets("参数表")
    
17.         .UsedRange.Offset(1).ClearContents
    
18.         .[a2].Resize(m, 1) = brr
    
19.     End With
    
20.     MsgBox "OK！"
    
21. End Sub
    

复制代码

zhangmy66

ykcbf1100 发表于 2024-9-4 13:35
。。。。。。。。。。。

还待是你666