用代码实现分列的问题

weide_yang

K列中有N个源数据
想用代码实现：
在表此表中显示如宏效展示表的结果，恳请老师赐教，谢谢！
工作簿1.zip (11.74 KB, 下载次数: 13)

2024-11-6 08:38 上传

点击文件名下载附件

loirol

AA=REGEXEXTRACT(K2,"[一-龥]+")
BB=TEXT(MID(K2,FIND(A2,K2)+LEN(A2),999),"000000")

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim reg As New RegExp
   
5.     With reg
   
6.         .Global = False
   
7.         .Pattern = "\d{8}([\u4e00-\u9fbc]+)(\d{6})"
   
8.     End With
   
9.     With Worksheets("sheet1")
   
10.         .Columns(1).NumberFormatLocal = "@"
    
11.         r = .Cells(.Rows.Count, 11).End(xlUp).Row
    
12.         arr = .Range("k2:k" & r)
    
13.         ReDim brr(1 To UBound(arr), 1 To 2)
    
14.         For i = 1 To UBound(arr)
    
15.             Set mh = reg.Execute(arr(i, 1))
    
16.             If mh.Count > 0 Then
    
17.                 brr(i, 1) = mh(0).SubMatches(1)
    
18.                 brr(i, 2) = mh(0).SubMatches(0)
    
19.             End If
    
20.         Next
    
21.         .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
22.     End With
    
23. End Sub
    

复制代码

chxw68

用正则表达式实现的。

chxw68

1. Sub test2()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     With Worksheets("sheet1")
   
5.         .Columns(1).NumberFormatLocal = "@"
   
6.         r = .Cells(.Rows.Count, 11).End(xlUp).Row
   
7.         arr = .Range("k2:k" & r)
   
8.         ReDim brr(1 To UBound(arr), 1 To 2)
   
9.         For i = 1 To UBound(arr)
   
10.             brr(i, 1) = Right(arr(i, 1), 6)
    
11.             brr(i, 2) = Mid(arr(i, 1), 9, Len(arr(i, 1)) - 14)
    
12.         Next
    
13.         .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
14.     End With
    
15. End Sub
    

复制代码

chxw68

数据很整齐，用right()和mid()函数实现更简单。

xlj310

A2公式，又是练习正则公式的一天。
=REGEXP(G2:G8,{"^\d{8}","\d\K[一-龟]+(?=\d)"})

沧海一粟123123

Sub test()
Dim arr
Dim x As Integer
Dim arr1()
Dim arr2()
Dim arr3()

i = Range("k1").End(xlDown).Row
arr = Range("k2:k" & i)
ReDim arr1(1 To UBound(arr))
ReDim arr2(1 To UBound(arr))
ReDim arr3(1 To UBound(arr))
For x = 1 To UBound(arr)
    arr1(x) = Right(arr(x, 1), Len(arr(x, 1)) - 8)
    arr2(x) = Right(arr1(x), 6)
    arr3(x) = Left(arr1(x), Len(arr1(x)) - Len(arr2(x)))
Next x
Range("c2").Resize(UBound(arr)) = Application.Transpose(arr2)
Range("d2").Resize(UBound(arr)) = Application.Transpose(arr3)
End Sub

ykcbf1100

正则练习。。。

ykcbf1100

参与一下。。。
对于股票来说，中间这段不一定全是中文。