[已解决]求循环代码

xjralph

表格A里是上千个A股股票代码和股票名称，见表A,要把他做成表B的样子，谢谢。

最佳答案

月排行榜 / 总排行榜

林木水

2021-12-13 14:17

代码如下，思路用正则规则表达式就可以了。很简单，结果见附件

Sub 正则表达式()
Dim rxg As object
set rxg=CreateObject("vbscript.regexp")
Dim sr, m, mat

Dim arr(), brr(), k As Integer
   With rxg
    .Global = True
    .Pattern = "[\u4e00-\u9fa5]{1,}"
    sr = Sheet1.Range("a1").Value
    Set mat = .Execute(sr)
    For Each m In mat
        k = k + 1
        ReDim Preserve arr(1 To k)
        arr(k) = m
    Next m
    k = 0
    .Pattern = "[^\u4e00-\u9fa5]{1,}"
    Set mat = .Execute(sr)
    For Each m In mat
       k = k + 1
        ReDim Preserve brr(1 To k)
        brr(k) = m
    Next m
   End With
    Sheet2.Range("a1").Resize(UBound(arr)) = Application.Transpose(arr)
    Sheet2.Range("b1").Resize(UBound(arr)) = Application.Transpose(brr)
End Sub

跳转到最佳答案楼层

林木水

代码如下，思路用正则规则表达式就可以了。很简单，结果见附件

Sub 正则表达式()
Dim rxg As object
set rxg=CreateObject("vbscript.regexp")
Dim sr, m, mat

Dim arr(), brr(), k As Integer
   With rxg
    .Global = True
    .Pattern = "[\u4e00-\u9fa5]{1,}"
    sr = Sheet1.Range("a1").Value
    Set mat = .Execute(sr)
    For Each m In mat
        k = k + 1
        ReDim Preserve arr(1 To k)
        arr(k) = m
    Next m
    k = 0
    .Pattern = "[^\u4e00-\u9fa5]{1,}"
    Set mat = .Execute(sr)
    For Each m In mat
       k = k + 1
        ReDim Preserve brr(1 To k)
        brr(k) = m
    Next m
   End With
    Sheet2.Range("a1").Resize(UBound(arr)) = Application.Transpose(arr)
    Sheet2.Range("b1").Resize(UBound(arr)) = Application.Transpose(brr)
End Sub

林木水

解决问题记得给最佳

cutecpu

Sub demo()
   Set re = CreateObject("vbscript.regexp")
   re.Global = True
   re.Pattern = "(\d+)([^\d]+)"
   With Sheets(2)
      .Cells.ClearContents
      For Each m In re.Execute([a1])
         .[a1].Offset(r).Resize(, 2) = Array(m.submatches(0), m.submatches(1))
         r = r + 1
      Next
   End With
End Sub

蜀西

cutecpu 发表于 2021-12-14 16:24
Sub demo()
   Set re = CreateObject("vbscript.regexp")
   re.Global = True

版主大神，我有个新的VBA问题，帮我看看呗
用VBA代码实现大量IF+OR函数的效果

林木水

cutecpu 发表于 2021-12-14 13:24
Sub demo()
   Set re = CreateObject("vbscript.regexp")
   re.Global = True

方法学习了，点赞不过正则规则那好像不能满足。例子里面作者那个带字母的也算编号。