21楼推荐我到VBA解决

lpl625

tcdatongye 发表于 2023-8-19 08:27
Sub 提取()
Set reg = CreateObject("vbscript.regexp")
reg.ignorecase = True

现需支持新规则的关键字提取。
1、182行以上的提取规则须保留（不包含黄色物料）
2、182行以下的物料提取规则需右边红色框的关键字
请直接改附件，成功后回复上传。谢谢！

lpl625

tcdatongye 发表于 2023-8-16 18:39
Sub 提取()
Set reg = CreateObject("vbscript.regexp")
reg.Pattern = "^.*?\s*(([^/一-龡]*\d+[^/一- ...

还能优化吗？

lpl625

tcdatongye 发表于 2023-8-16 18:39
Sub 提取()
Set reg = CreateObject("vbscript.regexp")
reg.Pattern = "^.*?\s*(([^/一-龡]*\d+[^/一- ...

不能是吧？

jaxxcyh

原始数据采集时不规范，后期数据处理会非常麻烦

tcdatongye

lpl625 发表于 2024-8-20 10:06
不能是吧？

Sub 提取()
Set reg = CreateObject("vbscript.regexp")
reg.ignorecase = True
With Sheets(1)
  k = .Cells(65536, 2).End(xlUp).Row
  .Cells(1, 3).Resize(k, 2).ClearContents
  For i = 1 To k
    Select Case i
      Case Is < 183
        reg.Pattern = "^\s*.*?([^/]*?°[^/]*).*|^[一-龡]+/([^/]+/)?([\.\d]+([m-z][hf])?)/.*"
        If reg.test(.Cells(i, 2)) Then
           .Cells(i, 3) = "'" & reg.Replace(.Cells(i, 2), "$1$3")
        Else
          reg.Pattern = "^\s*.*?((?=[^/]*?[a-z])([^\(/一-龡]*\d+[^\(/一-龡]*)+).*"
          .Cells(i, 3) = reg.Replace(.Cells(i, 2), "$1")
        End If
      Case Else
        reg.Pattern = ".*?(\d+[a-z]?[rf]).*?(/\d+[a-z]?[av]).*"
        .Cells(i, 4) = reg.Replace(.Cells(i, 2), "$1$2")
        .Cells(i, 3) = Split(.Cells(i, 4), "/")(0)
    End Select
  Next i
End With
End Sub

lpl625

tcdatongye 发表于 2024-8-20 11:18
Sub 提取()
Set reg = CreateObject("vbscript.regexp")
reg.ignorecase = True

代码放进去，右边的没实现？

tcdatongye

这样处理就行了

lpl625

tcdatongye 发表于 2024-8-21 11:58
这样处理就行了

1、已实现的结果，放在C列。
2、其他物料若和黄底物料同类，以黄底物料规则为准。
3、代码不分行，其实就是在以前的代码基础上，更新黄底物料提取规则。
谢谢！

tcdatongye

可以自己先做一遍，把答案写出来，别人才能看出是什么情况

lpl625

tcdatongye 发表于 2024-8-21 17:55
可以自己先做一遍，把答案写出来，别人才能看出是什么情况

已做一遍，答案在E列。