用VBA根据A列内容生成B列样式

他们

用VBA根据A列内容生成B列样式

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.28
   
2.     With Sheets("Sheet1")
   
3.         r = .Cells(Rows.Count, 1).End(3).Row
   
4.         arr = .[a1].Resize(r, 1)
   
5.         ReDim brr(1 To 10000, 1 To 1)
   
6.         For i = 1 To r
   
7.             l = InStr(LCase(arr(i, 1)), "k")
   
8.             st1 = Left(arr(i, 1), l)
   
9.             st = Split(arr(i, 1), "～")
   
10.             r1 = Val(Replace(st(0), st1, ""))
    
11.             r2 = Val(Replace(st(1), st1, ""))
    
12.             For x = r1 To r2
    
13.                 m = m + 1
    
14.                 brr(m, 1) = st1 & x
    
15.             Next
    
16.         Next
    
17.         .Columns(2) = ""
    
18.         .[b1].Resize(m, 1) = brr
    
19.     End With
    
20.     MsgBox "OK！"
    
21. End Sub
    

复制代码

cidanji

1. Sub ss()
   
2. Dim r&, i&, j&, d As Object, x, s$, a&, b&, n&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. r = Cells(Rows.Count, 1).End(3).Row
   
5. With CreateObject("VBScript.RegExp")
   
6.     .Pattern = "(.+?)(\d+)～.+?(\d+)$"
   
7.     For i = 1 To r
   
8.         x = Cells(i, 1)
   
9.         If .Test(x) Then
   
10.             s = .Replace(x, "$1")
    
11.             a = Val(.Replace(x, "$2"))
    
12.             b = Val(.Replace(x, "$3"))
    
13.             For j = a To b
    
14.                 n = n + 1: d(n) = s & j
    
15.             Next
    
16.         End If
    
17.     Next
    
18. End With
    
19. Columns(2).ClearContents
    
20. If d.Count Then [B1].Resize(d.Count, 1) = Application.Transpose(d.items)
    
21. End Sub

复制代码

LIUZHU

JSA做的效果

LIUZHU

JSA代码供参考

1. function 整理数据(){
   
2.         let arr=Range("a1:a"+ Range("a"+ Rows.Count).End(xlUp).Row).Value2;
   
3.         let res=arr.reduce((res,[x])=>{
   
4.                 let [key,min,,max]=x.match(/\d+/g);
   
5.                 for (i=min;i<=max;i++) res.push([`${key}K${i}`]);
   
6.                 return res;
   
7.         },[]);
   
8.         Range("b1").Resize(res.length,res[0].length).Value2=res;
   
9. }

复制代码

LIUZHU

WPS打开，点击按钮

chxw68

参与一下。