меня интересует именно <Start>663894.452737859 -6160205.42335494</Start><End>663794.791098493 -6160222.97523945 составил табличку.
не правильные
правильные
663894.452737859 -6160205.42335494
6160205.42335494 663894.452737859
табличка не работает значений много. как с помощью макроса найти значения из правой ячейки и поменять их на значения из левой? или как сделать преобразования значений сразу в правильные. ( оба значения должны быть положительными и их надо поменять местами)
Sub Replace_xml()
Dim xmlDoc
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.async = False
xmlDoc.validateOnParse = False
strFilePath = "C:\Users\Сергей\Desktop\Файл примера.xml"
xmlDoc.Load (strFilePath)
Dim objListOfNodes
xmlDoc.setProperty "SelectionLanguage", "XPath"
XPath = "//Start"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
Set StartNode = objListOfNodes(n)
StartText = StartNode.Text
If InStr(1, StartText, "-", vbTextCompare) > 0 Then
StartR = Split(StartText, "-")
StartNode.Text = StartR(1) & " " & StartR(0)
End If
Next
XPath = "//End"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
Set EndNode = objListOfNodes(n)
EndText = EndNode.Text
If InStr(1, EndText, "-", vbTextCompare) > 0 Then
EndR = Split(EndText, "-")
EndNode.Text = EndR(1) & " " & EndR(0)
End If
Next
xmlDoc.Save strFilePath
End Sub
только я не могу понять как работает скрипт. XPath = "//Start" ( я так понимаю начинает работать с <Start> </Start>)
а вот к примеру есть <Point name="11" cameFromLiveInterop="True" picketage="139 1 64.998" seqNo="11">664538.194 -6159896.711 0</Point> тут достаточно XPath = "//Point" ? и нолик останется на месте?
Doober, все на английском (английский в школе мимо меня прошел )
Код
Next
XPath = "//NodeLocation"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
Set NodeLocationNode = objListOfNodes(n)
NodeLocationText = NodeLocationNode.Text
If InStr(1, NodeLocationText, "-", vbTextCompare) > 0 Then
NodeLocationR = Split(NodeLocationText, "-")
NodeLocationNode.Text = NodeLocationR(1) & " " & NodeLocationR(0)
End If
Next
Для каждого элемента надо менять все что красным. А как это делать в пару кликов? а не ручками копи паст?
vikttur написал: Код в сообщении следует оформлять с помощью кнопки . Вместо выделения цветом достаточно написать: "Заменить везде NodeLocation"
Я что-то в "Microsoft Visual Basic fof Application" - изначально не заметил . Думаю через ( Ctrl+H ) удобнее будет кусок код менять.
Код
Sub Replace_xml()
Dim xmlDoc
Dim iTrek
With Application.FileDialog(msoFileDialogOpen)
If .Show = 0 Then MsgBox "Файл не выбран!", 64, "ошибка": Exit Sub
iTrek = .SelectedItems(1)
End With
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.async = False
xmlDoc.validateOnParse = False
strFilePath = iTrek
xmlDoc.Load (strFilePath)
Dim objListOfNodes
xmlDoc.setProperty "SelectionLanguage", "XPath"
XPath = "//Start"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
Set StartNode = objListOfNodes(n)
StartText = StartNode.Text
If InStr(1, StartText, "-", vbTextCompare) > 0 Then
StartR = Split(StartText, "-")
StartNode.Text = StartR(1) & " " & StartR(0)
End If
Next
XPath = "//End"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
Set EndNode = objListOfNodes(n)
EndText = EndNode.Text
If InStr(1, EndText, "-", vbTextCompare) > 0 Then
EndR = Split(EndText, "-")
EndNode.Text = EndR(1) & " " & EndR(0)
End If
Next
XPath = "//PI"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
Set PINode = objListOfNodes(n)
PIText = PINode.Text
If InStr(1, PIText, "-", vbTextCompare) > 0 Then
PIR = Split(PIText, "-")
PINode.Text = PIR(1) & " " & PIR(0)
End If
Next
XPath = "//Center"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
Set CenterNode = objListOfNodes(n)
CenterText = CenterNode.Text
If InStr(1, CenterText, "-", vbTextCompare) > 0 Then
CenterR = Split(CenterText, "-")
CenterNode.Text = CenterR(1) & " " & CenterR(0)
End If
Next
XPath = "//NodeLocation"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
Set NodeLocationNode = objListOfNodes(n)
NodeLocationText = NodeLocationNode.Text
If InStr(1, NodeLocationText, "-", vbTextCompare) > 0 Then
NodeLocationR = Split(NodeLocationText, "-")
NodeLocationNode.Text = NodeLocationR(1) & " " & NodeLocationR(0)
End If
Next
XPath = "//Point"
Set objListOfNodes = xmlDoc.SelectNodes(XPath)
For n = 0 To objListOfNodes.Length - 1
Set PointNode = objListOfNodes(n)
PointText = PointNode.Text
If InStr(1, PointText, "-", vbTextCompare) > 0 Then
PointR = Split(PointText, "-")
PointNode.Text = PointR(1) & " " & PointR(0)
End If
Next
xmlDoc.Save strFilePath
End Sub
Вот сам код в друг кому понадобится. при запуске спрашивает где лежит файл и сразу его меняет!!!! Все действия проводите только после создания копии.