Страницы: 1
RSS
Поиск и замена в XML через VBA
 
Добрый день, подскажите, с XML в VBA раньше не работал, есть вопрос. Как средствами VBA в конкретных тегах заменить значение на другое во всем документе? Вроде задача не сложная и я думаю уже решалась кем-то сто раз, но я хз с чего начать, помогите плз. Например есть тег: <aa:1>что-то</aa:1> и заменить на <aa:1>*другое*</aa:1>
Помогите плиз.
Изменено: Argo9 - 16.10.2019 13:38:28
 
Цитата
с чего начать
Возможно с регулярных выражений, см. в Приемах
 
ну не настолько не с чего начать) имелось ввиду опыта работы с xml нет)
 
Цитата
Argo9 написал:
ну не настолько не с чего начать) имелось ввиду опыта работы с xml нет)
А что Вы тогда хотели?! Вы спросили "С чего начать" - вас отправили к регулярным выражениям. XML это тот же текст и в нём можно найти интересующие Вас куски и заменить посредством регулярных выражений.
Если хотите чтобы всё сделали за Вас, то хотя бы пример выложете, может кто заморочится.
Изменено: Wiss - 16.10.2019 14:26:06
Я не волшебник, я только учусь.
 
ну я вроде разобрался, только есть вопрос. Как зная регулярные выражения, запустить цикл для каждой строки в текстовом документе или XML имея как пример следующий код

Код
Sub XML()
    Dim cell As Range
    For Each cell In ActiveSheet.UsedRange.Columns(31).Cells
        cell = XML_DeleteAttributes(cell)
    Next cell
End Sub
 
Function HTML_DeleteAttributes(ByVal txt$)
    On Error Resume Next
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(<[A-Za-z1-6]+)[^<>]*(>)"
        txt$ = .Replace(txt$, "$1$2")
        .Pattern = ">\s*<"
        txt$ = .Replace(txt$, "><")
    End With
    XML_DeleteAttributes = txt$
End Function



конкретно интересует процедура. Спасибо.
Изменено: Argo9 - 16.10.2019 18:17:17
 
Рад, что Вы вернулись. Я уж думал, что тема умерла.
1. Оформите код в сообщении (кнопочка <...>), а то админы ругаться будут.
2. Не могу понять в чем проблема. Ваша программа должна пробегать по каждой ячейке в столбце 31 и преобразовывать в ней значения через regExp. Что не так?
3. Может все-таки файл-пример нужен?
Я не волшебник, я только учусь.
 
Мне не нужно делать это в excel документе, я хотел бы сделать это в xml или txt документе.
Хотелось бы пробегать в каждой строке таких документов и преобразовывать в ней значение.
Хотя я понимаю что можно создавать временный эксель документ вбивать каждую строку в ячейку, пробегать по ячейкам в столбце, затем преобразованный диапазон переносить в txt. Но думается есть вариант элегантней.
 
Понял. Тогда Вам в сторону работы с текстовыми файлами. Сижу с телефона, это лучшее, что удалось найти.
Я не волшебник, я только учусь.
 
Как пример можно вот это использовать. Выбирает файл, открывает, преобращует, сохраняет под новым именем.
Я не волшебник, я только учусь.
 
Короче, еще вопрос, вот этот код уже работает в Excel, так что пол дела есть.

Код
Sub HTML()
    Dim cell As Range
    For Each cell In ActiveSheet.UsedRange.Columns(9).Cells
        cell = HTML_DeleteAttributes(cell)
    Next cell
End Sub
 
Function HTML_DeleteAttributes(ByVal txt$)
    On Error Resume Next
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "[<ns1:INN>]\d{10}[</ns1:INN>]"
        txt$ = .Replace(txt$, ">Удаленно<")
        '.Pattern = "[<ns1:OGRN>]\d*[</ns1:OGRN>]"
        'txt$ = .Replace(txt$, ">куку епт<")
    End With
    HTML_DeleteAttributes = txt$
End Function


Мне надо искать сразу несколько по нескольким условиям, но если писать как я отметил комментарием, то он выдает кашу. Может сделать несколько разных функций и вызывать их для каждой строки. Просто код тогда будет опять же не эстетичным. Может вопрос глупый, но я сам написал только 4 макроса.
Изменено: Argo9 - 17.10.2019 10:30:41
 
Сделать функцию.
Код
Function HTML_DeleteAttributes(ByVal txt$,  byval sPattern as String)
И запускать её столько, сколько нужно. А по поводу каши - подсказать не смогу, пока не увижу файл-пример :)
Я не волшебник, я только учусь.
 
Это часть нужного xml, мне кажется я не правильно написал регулярку для ОГРН

Код
</ns1:Creditor>   
<ns1:ProductInfo xmlns:ns1="">   
<ns1:ListOfCovGroupParticipants>   
<ns1:CovGroupParticipant>   
<ns1:Name>ООО Колобок</ns1:Name>   
<ns1:INN>4664444444</ns1:INN>   
<ns1:OGRN>46604444</ns1:OGRN>   
<ns1:PARTTYPE>UL</ns1:PARTTYPE>   
</ns1:CovGroupParticipant>   
</ns1:ListOfCovGroupParticipants>   


в вашем примере sPattern это типо само регулярное выражение?

и в дальнейшем писать так?->

Код
.Pattern = sPattern



я так понял?
Изменено: Argo9 - 17.10.2019 10:43:34
 
Д
Цитата
Argo9 написал:
и в дальнейшем писать так?->
Ну да.
По поводу того, что в регулярке ошибка - тоже "Да". Я сам в них плаваю, но там точно не нужны квадратные скобки.
Вот полезный сайтик, для проверки регулярных выражений.
Изменено: Wiss - 17.10.2019 10:54:22
Я не волшебник, я только учусь.
 
Код
Sub HTML()
    Dim cell As Range
    For Each cell In ActiveSheet.UsedRange.Columns(9).Cells
        cell = HTML_DeleteAttributes(cell)
    Next cell
End Sub
 
Function HTML_DeleteAttributes(ByVal txt$)
    On Error Resume Next
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "[<ns1:INN>]\d{10}[</ns1:INN>]"
        txt$ = .Replace(txt$, ">Удаленно<")
        .Pattern = "<ns1:OGRN>\d+</ns1:OGRN>"
        txt$ = .Replace(txt$, "<ns1:OGRN>КУКУ</ns1:OGRN>")
    End With
    HTML_DeleteAttributes = txt$
End Function


Все, в Excel это работает нормально и логично пока. Даже с несколькими регулярками в функции(как и должно в общем). Пока буду разбераться с циклом в XML или txt по строкам. Пока функцию здесь оставлю, может кто кинет готовый вариант=)) просто кажеться что решение готовое.
Wiss, спасибо за помощь!!
Изменено: Argo9 - 17.10.2019 11:04:30
 
А зачем кого-то ждать?! В моём файле-примере заменить цикл For i = 1 to ... на
Код
FileContent = HTML_DeleteAttributes(FileContent)
+ имя выходного файла отредактировать и вуаля.

Но если нельзя целиком весь файл редактировать, а только конкретные строки, то это уже в отдельную тему.
С файлом-примером ;)
Изменено: Wiss - 17.10.2019 11:10:42
Я не волшебник, я только учусь.
 
Код
Sub minus1()
    Dim FileContent
    Dim tX As Long
    Dim i As Long
    Dim s As String
    Dim sRes As String
    
    Dim sFileName
    
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        .Show

        If .SelectedItems.Count <> 0 Then sFileName = .SelectedItems(1)
 
    End With
    
    If sFileName = "" Then
        MsgBox "Файл не выбран", , ""
        Exit Sub
    End If

    tX = FreeFile
    
    Open sFileName For Input As tX

    FileContent = Input(LOF(tX), tX)
    
    Close tX
    
    For i = 1 To Len(FileContent)
        FileContent = HTML_DeleteAttributes(FileContent)
    Next i


    tX = FreeFile
    
    Open ThisWorkbook.Path & "\преобразовано.txt" For Output As tX
    
    Print #tX, sRes
    
    Close tX
End Sub

Function HTML_DeleteAttributes(ByVal txt$)
    On Error Resume Next
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "[<ns1:INN>]\d{10}[</ns1:INN>]"
        txt$ = .Replace(txt$, ">Удаленно<")
        .Pattern = "<ns1:OGRN>\d+</ns1:OGRN>"
        txt$ = .Replace(txt$, "<ns1:OGRN>КУКУ</ns1:OGRN>")
    End With
    HTML_DeleteAttributes = txt$
End Function


Короче, возвращает пустой файл, шо не так?)

на самом деле, просто бы узнать как определить последнюю строку в текстовом файле и чем заменить Cell в случае текстового файла. Ничего адекватного не нашел
Изменено: Argo9 - 17.10.2019 12:41:26
 
Print #tX, sRes
sRes же пустой.
Изменено: Wiss - 17.10.2019 13:19:04
Я не волшебник, я только учусь.
Страницы: 1
Наверх