想通过宏分拆补齐填写表格

gzclc

想通过宏分拆补齐填写表格。




E列填写《数据》B列数字左边的字母；

F列填写《数据》B列6位文本数字；

G列填写《数据》B列数字右边的相关字母及数字。

taller

taller

1. Option Explicit
   
2. 
   
3. Sub Demo()
   
4.     Dim i As Long, j As Long, n As Long
   
5.     Dim strTxt As String
   
6.     Dim arrData, aTxt, arrRes, dataRng As Range
   
7.     Dim objRegExp As Object, objMatch As Object
   
8.     Set dataRng = [B4].CurrentRegion
   
9.     arrData = dataRng.Value
   
10.     ReDim arrRes(1 To UBound(arrData), 0 To 2)
    
11.     n = 0
    
12.     Set objRegExp = CreateObject("vbScript.Regexp")
    
13.     With objRegExp
    
14.         .Global = True
    
15.         .MultiLine = True
    
16.         .Pattern = "([A-Z]*)(\d{6})(?:.*?([AB]\d))*"
    
17.         .IgnoreCase = True
    
18.         For i = 1 To UBound(arrData)
    
19.             strTxt = arrData(i, 1)
    
20.             Set objMatch = objRegExp.Execute(strTxt)
    
21.             If objMatch.Count > 0 Then
    
22.                 n = n + 1
    
23.                 For j = 0 To objMatch(0).submatches.Count - 1
    
24.                     arrRes(n, j) = objMatch(0).submatches(j)
    
25.                     If IsNumeric(arrRes(n, j)) And Len(arrRes(n, j)) > 0 Then _
    
26.                         arrRes(n, j) = "'" & arrRes(n, j)
    
27.                 Next
    
28.             End If
    
29.         Next
    
30.     End With
    
31.     With dataRng.Offset(, 3).Resize(, 3)
    
32.         .Value = arrRes
    
33.         With .Columns(1)
    
34.             .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    
35.             .Value = .Value
    
36.         End With
    
37.         With .Columns(3)
    
38.             .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[1]C"
    
39.             .Value = .Value
    
40.         End With
    
41.     End With
    
42.     Set objRegExp = Nothing
    
43.     Set objMatch = Nothing
    
44. End Sub
    

复制代码

excel玉米

gzclc

taller 发表于 2024-4-14 08:22

谢谢版主，我学习消化。

gwjkkkkk

正则。。。。。。

LIUZHU

JSA代码，做起来还是有些麻烦的

1. function 分拆补齐(){
   
2.         let arr=Sheets.Item("数据").Range("b4:b15").Value2.flat();
   
3.         let regex1=/^[A-Z]+/,regex2=/[AB]\d(?=[\)）])/;
   
4.         let res=arr.reduce((res,x,i)=>{
   
5.                 let s1=arr.slice(0,i+1).reduce((s1,y)=>s1=regex1.test(y)?y.match(regex1)[0]:s1,"");
   
6.                 let s2=arr.slice(i,arr.length).reduce((s2,y)=>s2=regex2.test(y) && s2==""?y.match(regex2)[0]:s2,"");
   
7.                 return (res.push([s1,String(x).match(/\d{6}/)[0],s2]),res);
   
8.         },[]);
   
9.         Range("e4").Resize(res.length,res[0].length).Value2=res;
   
10. }

复制代码

LIUZHU

好像是这个效果

LIUZHU

附件在此，WPS测试