提取文本内容，有的正常，有的异常，求助

雷沛qaz · 发表于 2023-3-12 17:42

我看别人的代码，自己写的代码，目前提取5列数值，2列正常，3列异常，请帮忙找下原因或者另辟蹊径帮忙重新写下
（需要图片中I列和J列字符串中间的数字，VBA代码也有写），感谢！

雷沛qaz · 发表于 2023-3-12 17:43

附件没看到，重新发下

wanao2008 · 发表于 2023-3-12 19:53

希望能够帮助到你：

Sub byWanao()
Dim oDoc As Object, myPath$, f As Object, k&, i&
Range("A1:E1") = Array("转速", "比例不匹配排名", "垂直度排名", "间隙X排名", "间隙Y排名")
i = 1
Set oDoc = CreateObject("MSXML2.DOMDocument")
For Each f In CreateObject("scripting.filesystemobject").getfolder(ThisWorkbook.Path & "\提取").Files
i = i + 1
k = 0
oDoc.Load f.Path
Dim oErr As Object
If oDoc.parseError.ErrorCode <> 0 Then
Set oErr = oDoc.parseError
Debug.Print oErr.reason
End If
Dim oVariables As Object
Dim oVariable As Object
Set oVariables = oDoc.SelectNodes("/TEST_DOCUMENT/TEST_SPEC/INSTRUMENT/DYNAMIC_BALLBAR/PROGRAMMED_FEEDRATE")
Cells(i, k) = oVariables.Item(0).Text
Set oVariables = oDoc.SelectNodes("/TEST_DOCUMENT/ANALYSIS/FEATURE")
For Each oVariable In oVariables
Select Case oVariable.Attributes(0).nodeTypedValue
Case "AF_SCALE_MISMATCH_RANK", "AF_SQUARENESS_RANK", "AF_LATERAL_PLAY_A_RANK", "AF_BACKLASH_B_RANK"
k = k + 1
Cells(i, k) = oVariable.Text
End Select
Next
Next
End Sub

复制代码

准备学XML的xPath解析，还请大佬多提宝贵建议。
如果可能的话，请大佬提供一些相关的学习资料，万分感谢！！！！

洋务德雷 · 发表于 2023-3-12 20:42

看一下吧，我用正则表达式修改的。

雷沛qaz · 发表于 2023-3-13 14:36

wanao2008 发表于 2023-3-12 19:53
希望能够帮助到你：

执行到图片处示警

雷沛qaz · 发表于 2023-3-13 14:40

洋务德雷发表于 2023-3-12 20:42
看一下吧，我用正则表达式修改的。

我添加其他条件时提取出来只有整数，可以优化提取结果含小数吗

洋务德雷 · 发表于 2023-3-13 15:32

雷沛qaz 发表于 2023-3-13 14:40
我添加其他条件时提取出来只有整数，可以优化提取结果含小数吗

排名还有小数呢？

雷沛qaz · 发表于 2023-3-13 15:41

如果我想提取下边字符串中间数值，就不通用了：
<FEATURE NAME="AF_SQUARENESS" DT="UT_SQUARENESS">115.9</FEATURE>
<FEATURE NAME="AF_LATERAL_PLAY_A_NEG" DT="UT_LENGTH_UM">-1.6</FEATURE>

洋务德雷 · 发表于 2023-3-13 16:08

把模块1里面的换成这个

Function GetN(str As String, findStr As String) As Double
Dim regex As Object
Dim mat As Object, mas As Object
Set regex = CreateObject("vbscript.regexp")
With regex
.Global = True
.ignorecase = True
.Pattern = findStr & "\D+(\d+\.?(\d*))"
Set mat = .Execute(str)
For Each mas In mat
GetN = mas.submatches(0)
Exit For
Next
' GetN = 0
End With
Set regex = Nothing
Set mat = Nothing
End Function

复制代码

洋务德雷 · 发表于 2023-3-13 17:10

Function GetN(str As String, findStr As String) As Double
Dim regex As Object
Dim mat As Object, mas As Object
Set regex = CreateObject("vbscript.regexp")
With regex
.Global = True
.ignorecase = True
.Pattern = findStr & "\D+(\d+\.?(\d*))"
Set mat = .Execute(str)
For Each mas In mat
GetN = mas.submatches(0)
Exit For
Next
' GetN = 0
End With
Set regex = Nothing
Set mat = Nothing
End Function

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 提取文本内容，有的正常，有的异常，求助