您好！求助提取（第一个）百分号%前的数字

taorigin

您好高手，
向您求思路与代码，我需要对大批数据，按增长百分比从大到小排序，最典型的数据字段如下：

1）有些增长幅度是区间结构，150%-190%，但我只需取区间开始值150%；
2）请帮助用VBA实现。
感谢您，给您添麻烦了！

上海化工品有限公司：预计2019年净利润增长150%-190%
江苏海洋冷链运输公司2019年净利同比增长57%
辽宁石化设备公司预计2019年净利润增48%-77%
贵州长滩海产品公司：预计2019年净利润预增381.58%-394.49%
宁波港拟定增募资，推进宁波港现代化建设

zyr2046

Sub test()
    Dim i%, arr, brr
    arr = Sheet1.Range("a1").CurrentRegion
    ReDim brr(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arr)
        arr(i, 1) = Replace(arr(i, 1), "增长", "增")
        brr(i, 1) = Mid(arr(i, 1), InStr(arr(i, 1), "增") + 1, InStr(arr(i, 1), "%") - InStr(arr(i, 1), "增"))
    Next
    Sheet1.Range("b1").Resize(10000, 1).ClearContents
    Sheet1.Range("b1").Resize(UBound(arr), 1) = brr
End Sub

zyr2046

这地方按照你已经给出的数据，把“增长”替换成“增”，再进行字符查找

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.   End With
   
9.   With Worksheets("sheet1")
   
10.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
11.     arr = .Range("a1:a" & r)
    
12.     ReDim brr(1 To UBound(arr), 1 To 1)
    
13.     For i = 1 To UBound(arr)
    
14.       Set mh = reg.Execute(arr(i, 1))
    
15.       If mh.Count > 0 Then
    
16.         brr(i, 1) = mh(0).SubMatches(0)
    
17.       End If
    
18.     Next
    
19.     .Range("b1").Resize(UBound(brr), 1) = brr
    
20.   End With
    
21. End Sub
    

复制代码

chxw68

详见附件。

microyip

对于录入规范的文字，6楼褚老师的正则是OK的，但建议使用

1. .Pattern = "\d+(?:\.\d+)?%"

复制代码

taorigin

十分感谢褚老师的正则表达式解决之道！！也满怀敬意的感谢 zyr2046  和 microyip  谢谢你们，当代活雷锋！

sirsunny

microyip 发表于 2020-1-31 09:28
对于录入规范的文字，6楼褚老师的正则是OK的，但建议使用

请问使用(?:)不分配组是什么意思啊？看不懂

excel海

考虑负增长
.Pattern = "(-?\d+(?:\.\d+)?)%"