求助修改代码

赵龙，

目的：提取A1单元格内容中提取电缆规格并返回芯数及单芯最大截面面积，如下内容返回5和185.   其中5是由3和2构成。

如A1单元格内容如下：

1.名称:无卤低烟B1类电缆

2.型号:WDZB1-YJY-0.6/1KV

3.规格:3*185+2*95

4.敷设方式、部位:桥架、穿管

5.其它：具体详见设计图纸及相关技术要求

目前代码如下，但不能显示正确结果，请高人修改，小白在此感谢



Sub ExtractCableSpecs() '定义一个子过程，名称为ExtractCableSpecs
    '获取电缆规格字符串
    Dim cableSpecs As String '声明字符串变量cableSpecs，用于存放电缆规格信息
    cableSpecs = Range("A1").Value '将单元格A1中的值赋给cableSpecs变量
   
    '使用正则表达式提取电缆最大截面和芯数
    Dim regex As Object '声明对象变量regex，用于存放VBScript.RegExp对象
    Set regex = CreateObject("VBScript.RegExp") '新建VBScript.RegExp对象并将其赋给regex变量
    regex.Pattern = "(\d+)\*(\d+)" '设置正则表达式的模式，匹配数字*数字的模式
    Dim matches As Object '声明对象变量matches，用于存放匹配结果
    Set matches = regex.Execute(cableSpecs) '使用正则表达式匹配电缆规格信息，并将结果赋给matches变量
   
    '遍历匹配结果，提取最大截面和芯数
    Dim maxArea As Integer '声明整型变量maxArea，用于存放最大截面
    Dim coreCount As Integer '声明整型变量coreCount，用于存放芯数
    For Each Match In matches '遍历匹配结果
        Dim area As Integer '声明整型变量area，用于存放单个匹配项的截面
        Dim count As Integer '声明整型变量count，用于存放单个匹配项的芯数
        count = CInt(Match.SubMatches(0)) '将匹配项中第一个子匹配项（即数字*数字中的第一个数字）转换为整型并赋给area变量
        area = CInt(Match.SubMatches(1)) '将匹配项中第二个子匹配项（即数字*数字中的第二个数字）转换为整型并赋给count变量
        If area > maxArea Then '如果当前匹配项的截面大于maxArea变量中存储的最大截面
            maxArea = area '将当前匹配项的截面赋给maxArea变量
        End If
        coreCount = coreCount + count '将当前匹配项的芯数加到coreCount变量中
    Next Match '继续遍历下一个匹配项
   
    '输出结果
     Range("B1").Value = coreCount '将提取出的芯数输出到单元格B1中  
     Range("C1").Value = maxArea '将提取出的最大截面输出到单元格C1中
   
End Sub

taller

赵龙，

taller 发表于 2023-3-31 13:07

感谢