求助大神，提取数据【已解决】

x7893930

麻烦大神，思路有，基础有点差，真的写不出来了


将A列内  汇率提取出来，有的前面是空格  有的前面是英文冒号   有的是中文冒号  还有直接跟在汇率俩字后面的，有的三位小数  有的两位  有的四位

我的思路是找到  7点（汇率都是7.****），提取出来以后，然后打散单元格内容，逐位判定isnumber，然后再提取出来。

shiruiqiang

直接正则：7\.\d+

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, i&
   
    ar = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
    ar(1, 1) = "提取汇率"
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "7\.[0-9]+"
        For i = 2 To UBound(ar)
            If .test(ar(i, 1)) Then
                ar(i, 1) = .Execute(ar(i, 1))(0)
            Else
                ar(i, 1) = Empty
            End If
        Next i
    End With
   
    Columns("B").Clear
    [B1].Resize(UBound(ar)) = ar
    Beep
End Sub

gwjkkkkk

.............

x7893930

shiruiqiang 发表于 2024-6-4 19:35
直接正则：7\.\d+

大神您好，VBA要怎么写正则？麻烦给指点一下，正则表达式不会写

shiruiqiang

x7893930 发表于 2024-6-4 19:41
大神您好，VBA要怎么写正则？麻烦给指点一下，正则表达式不会写

看附件，写好了

x7893930

shiruiqiang 发表于 2024-6-4 19:35
直接正则：7\.\d+

感谢大神，快准狠，向您学习

x7893930

gwjkkkkk 发表于 2024-6-4 19:39
.............

万分感谢，大神厉害

dambcer

Qs18

Function ERate(cellText As String) As String
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "(\d+\.\d+)"
    regex.Global = True
    regex.IgnoreCase = True
    Dim matches As Object
    Set matches = regex.Execute(cellText)
    If matches.Count > 0 Then
        ERate = matches(0).Value
    Else
       ERate = "No Exchange Rate Found"
    End If
    Set regex = Nothing
    Set matches = Nothing
End Function
Sub 提取数字()
    Dim ws As Worksheet
    Set ws = Sheet1
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 获取A列最后一个非空单元格的行号
   
    Dim cell As Range
    Dim result As String
   
    ' 遍历A列中的每个单元格
    For Each cell In ws.Range("A2:A" & lastRow)
        result = ERate(cell.Value)
        ' 将提取的汇率放在B列对应的单元格中
        ws.Cells(cell.Row, "b").Value = result
    Next cell
    MsgBox "完成！"
End Sub