Подход с использованием функции FilterXML
Функция WorksheetFunction FilterXML()
была добавлена в ►Excel 2013 и позволяет указать любую XPath строку поиска дляданный XML-документ, который не должен быть локально сохраненным файлом (для которого требуется функция WebService()
), но может быть строкой в правильно сформированных открывающих и закрывающих узлах, т.е. нашей тестовой строке с некоторыми простыми добавлениями узлов(частично сопоставимо со структурой html).
Пример вызова
Sub TextXML()
Dim myString As String
myString = "ABCD blah"
If check(myString) Then
'DO STUFF
Debug.Print "okay"
Else
Debug.Print "oh no"
End If
End Sub
Функция справки
Function check(ByVal teststring As String) As Boolean
Const s As String = Chr(185) ' unusual character, e.g. Chr(185): "¹"
On Error GoTo oops
If Len(WorksheetFunction.FilterXML("<all><i>" & teststring & "</i></all>", "//i[substring(translate(.,'ABCDEFGHIJKLMNOPQRSTUVWXYZ','" & _
String(26, s) & "'),1,4)='" & String(4, s) & "']")) > 0 Then check = True
Exit Function
oops:
Err.Clear
End Function
tl; tr - как использовать VBA в версиях Excel до 2013 года
Ради искусства классический способ использования XPath с помощью методов XMLDOM:
Примервызов
Sub TextXML2()
Dim myString As String
myString = "ABCD blah"
If check2(myString) Then
'DO STUFF
Debug.Print "okay"
Else
Debug.Print "oh no"
End If
End Sub
Функции справки
Function check2(ByVal teststring As String) As Boolean
' Purpose: check if first 4 characters of a test string are upper case letters A-Z
' [0] late bind XML document
Dim xDoc As Object
Set xDoc = CreateObject("MSXML2.DOMDocument.6.0")
' [1] form XML string by adding opening and closing node names ("tags")
teststring = "<all><i>" & teststring & "</i></all>"
' [2] load XML
If xDoc.LoadXML(teststring) Then
' [3a] list matching item(s) via XPath
Dim myNodeList As Object
Set myNodeList = xDoc.SelectNodes(XPath())
'Debug.Print teststring, " found: " & myNodeList.Length
' [3b] return true if the item matches, i.e. the list length is greater than zero
If myNodeList.Length > 0 Then check2 = True
End If
End Function
Function XPath() As String
' Purpose: create XPath string to get nodes where the first 4 characters are upper case letters A-Z
' Result: //i[substring(translate(.,'ABCDEFGHIJKLMNOPQRSTUVWXYZ','¹¹¹¹¹¹¹¹¹¹¹¹¹¹¹¹¹¹¹¹¹¹¹¹¹¹'),1,4)="¹¹¹¹"]
' get UPPER case alphabet
Const ABC As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
' define replacement string consisting of an unusual character repeated 26 times
Const UNUSUAL As String = "¹" ' << replace by your preferenced character
Dim replacement As String: replacement = String(Len(ABC), UNUSUAL)
'return XPath string
XPath = "//i[substring(translate(.,'" & ABC & "','" & replacement & "'),1,4)=""" & String(4, UNUSUAL) & """]"
End Function