Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Необходимо массово заменить текст в файлах (VBA)? - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Необходимо массово заменить текст в файлах (VBA)? (Макросы/Sub)
Необходимо массово заменить текст в файлах (VBA)?
cobra77777 Дата: Среда, 12.07.2017, 13:18 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 51
Репутация: 0 ±
Замечаний: 60% ±

Excel 2013
Здравствуйте!
Сразу говорю я в VBA - ноль.
Необходимо массово заменить текст в файлах (VBA) (~800 файлов).
Файл 1.txt.
"Фирма", "ООО Рога и Копыта" на "Фирма","ООО ТРС"
и т .д.

Как это можно сделать в VBA?

Спасибо


Сообщение отредактировал cobra77777 - Среда, 12.07.2017, 13:38
 
Ответить
СообщениеЗдравствуйте!
Сразу говорю я в VBA - ноль.
Необходимо массово заменить текст в файлах (VBA) (~800 файлов).
Файл 1.txt.
"Фирма", "ООО Рога и Копыта" на "Фирма","ООО ТРС"
и т .д.

Как это можно сделать в VBA?

Спасибо

Автор - cobra77777
Дата добавления - 12.07.2017 в 13:18
Udik Дата: Среда, 12.07.2017, 13:30 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 1493
Репутация: 184 ±
Замечаний: 0% ±

Excel 2016 х 64
Думаю, лучше переименовать тему, пока модераторы не занялись этим вопросом :) Ну и уточнить, что за файлы, какой текст.


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com


Сообщение отредактировал Udik - Среда, 12.07.2017, 13:32
 
Ответить
СообщениеДумаю, лучше переименовать тему, пока модераторы не занялись этим вопросом :) Ну и уточнить, что за файлы, какой текст.

Автор - Udik
Дата добавления - 12.07.2017 в 13:30
Udik Дата: Среда, 12.07.2017, 18:29 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1493
Репутация: 184 ±
Замечаний: 0% ±

Excel 2016 х 64
Нужно смотреть как данные в файле выглядят. То как Вы написали, приводит к такому алгоритму: ищем ищем пару подстрок, заключенную в кавычки и разделенную запятой, заменяем её. Это если под Фирма понимается подстрока Фирма. Но что-то я не уверен. Потом, если файлы текстовые, то можно и утилиты использовать по пакетной замене текста. В принципе и макросами можно, но нужно определить откуда брать имена файлов. Например, есть список, или все файлы в одной папке и т.д.


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
СообщениеНужно смотреть как данные в файле выглядят. То как Вы написали, приводит к такому алгоритму: ищем ищем пару подстрок, заключенную в кавычки и разделенную запятой, заменяем её. Это если под Фирма понимается подстрока Фирма. Но что-то я не уверен. Потом, если файлы текстовые, то можно и утилиты использовать по пакетной замене текста. В принципе и макросами можно, но нужно определить откуда брать имена файлов. Например, есть список, или все файлы в одной папке и т.д.

Автор - Udik
Дата добавления - 12.07.2017 в 18:29
cobra77777 Дата: Среда, 12.07.2017, 19:01 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 51
Репутация: 0 ±
Замечаний: 60% ±

Excel 2013
Выкладыаю файл. Да все файлы в одной папке.
Юдик да скачивал много разных программ + пробовал Notepad. Не получилось. Идёт обработка, но внутри ничего менялось.
Заранее спасибо.
К сообщению приложен файл: 00367304.173(0Kb)
 
Ответить
СообщениеВыкладыаю файл. Да все файлы в одной папке.
Юдик да скачивал много разных программ + пробовал Notepad. Не получилось. Идёт обработка, но внутри ничего менялось.
Заранее спасибо.

Автор - cobra77777
Дата добавления - 12.07.2017 в 19:01
Udik Дата: Среда, 12.07.2017, 19:42 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 1493
Репутация: 184 ±
Замечаний: 0% ±

Excel 2016 х 64
Название фирмы всегда идет первым и мы его заменяем на: название фирмы,"ООО ТРС" ?
И убираем группу в кавычках, если там есть ООО?
т.е. из

"ЗГЛы","П4.10","АРМ","11"
"СОБС","СОБС","016-606-123456",1653018920,165508009,"ООО Рога и Коплта"
"ПАЧК",4173,"ОПИСЬ","ОП61","01/01/2014",1,0,"","","","","",0,0,0,0,0,0,0,0,0

должно выйти

"ЗГЛы","ООО ТРС","П4.10","АРМ","11"
"СОБС","ООО ТРС","СОБС","016-606-123456",1653018920,165508009
"ПАЧК,"ООО ТРС"",4173,"ОПИСЬ","ОП61","01/01/2014",1,0,"","","","","",0,0,0,0,0,0,0,0,0

и кодировка в файле не та, нужно сменить на виндовую.


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
СообщениеНазвание фирмы всегда идет первым и мы его заменяем на: название фирмы,"ООО ТРС" ?
И убираем группу в кавычках, если там есть ООО?
т.е. из

"ЗГЛы","П4.10","АРМ","11"
"СОБС","СОБС","016-606-123456",1653018920,165508009,"ООО Рога и Коплта"
"ПАЧК",4173,"ОПИСЬ","ОП61","01/01/2014",1,0,"","","","","",0,0,0,0,0,0,0,0,0

должно выйти

"ЗГЛы","ООО ТРС","П4.10","АРМ","11"
"СОБС","ООО ТРС","СОБС","016-606-123456",1653018920,165508009
"ПАЧК,"ООО ТРС"",4173,"ОПИСЬ","ОП61","01/01/2014",1,0,"","","","","",0,0,0,0,0,0,0,0,0

и кодировка в файле не та, нужно сменить на виндовую.

Автор - Udik
Дата добавления - 12.07.2017 в 19:42
cobra77777 Дата: Среда, 12.07.2017, 19:47 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 51
Репутация: 0 ±
Замечаний: 60% ±

Excel 2013
Не совсем, а так НАЗВАНИЕ ФИРМЫ ДРУГАЯ НАПРИМЕР: "ООО ЗВЕЗДА"

"ЗГЛы","П4.10","АРМ","11"
"СОБС","СОБС","016-606-123456",1653018920,165508009,"ООО Рога и Коплта"
"ПАЧК",4173,"ОПИСЬ","ОП61","01/01/2014",1,0,"","","","","",0,0,0,0,0,0,0,0,0

должно выйти

"ЗГЛы","ООО ТРС","П4.10","АРМ","11"
"СОБС","ООО ТРС","СОБС","016-606-123456",1653018920,165508009, "ООО ЗВЕЗДА"
"ПАЧК,"ООО ТРС"",4173,"ОПИСЬ","ОП61","01/01/2014",1,0,"","","","","",0,0,0,0,0,0,0,0,0
 
Ответить
СообщениеНе совсем, а так НАЗВАНИЕ ФИРМЫ ДРУГАЯ НАПРИМЕР: "ООО ЗВЕЗДА"

"ЗГЛы","П4.10","АРМ","11"
"СОБС","СОБС","016-606-123456",1653018920,165508009,"ООО Рога и Коплта"
"ПАЧК",4173,"ОПИСЬ","ОП61","01/01/2014",1,0,"","","","","",0,0,0,0,0,0,0,0,0

должно выйти

"ЗГЛы","ООО ТРС","П4.10","АРМ","11"
"СОБС","ООО ТРС","СОБС","016-606-123456",1653018920,165508009, "ООО ЗВЕЗДА"
"ПАЧК,"ООО ТРС"",4173,"ОПИСЬ","ОП61","01/01/2014",1,0,"","","","","",0,0,0,0,0,0,0,0,0

Автор - cobra77777
Дата добавления - 12.07.2017 в 19:47
Udik Дата: Среда, 12.07.2017, 19:54 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 1493
Репутация: 184 ±
Замечаний: 0% ±

Excel 2016 х 64
что значит другое название, откуда его брать? Оно одно для всех файлов или как? И вопрос с кодировкой файлов остается открытым. Я читабельный текст только с помощью Штирлица получил, но как это провернуть для кучи файлов не знаю. Так что первоочередной вопрос получение нормального текста в кодировке ANSI :)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
Сообщениечто значит другое название, откуда его брать? Оно одно для всех файлов или как? И вопрос с кодировкой файлов остается открытым. Я читабельный текст только с помощью Штирлица получил, но как это провернуть для кучи файлов не знаю. Так что первоочередной вопрос получение нормального текста в кодировке ANSI :)

Автор - Udik
Дата добавления - 12.07.2017 в 19:54
cobra77777 Дата: Среда, 12.07.2017, 19:56 | Сообщение № 8
Группа: Пользователи
Ранг: Участник
Сообщений: 51
Репутация: 0 ±
Замечаний: 60% ±

Excel 2013
ДА название одно для ВСЕХ ФАЙЛОВ. КОДИРОВКА МОЯ ПРОБЛЕМА. СДЕЛАЮ.
 
Ответить
СообщениеДА название одно для ВСЕХ ФАЙЛОВ. КОДИРОВКА МОЯ ПРОБЛЕМА. СДЕЛАЮ.

Автор - cobra77777
Дата добавления - 12.07.2017 в 19:56
Udik Дата: Среда, 12.07.2017, 20:04 | Сообщение № 9
Группа: Друзья
Ранг: Старожил
Сообщений: 1493
Репутация: 184 ±
Замечаний: 0% ±

Excel 2016 х 64
Сегодня уже не успею, завтра попробую, если не опередят. :)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
СообщениеСегодня уже не успею, завтра попробую, если не опередят. :)

Автор - Udik
Дата добавления - 12.07.2017 в 20:04
cobra77777 Дата: Среда, 12.07.2017, 20:06 | Сообщение № 10
Группа: Пользователи
Ранг: Участник
Сообщений: 51
Репутация: 0 ±
Замечаний: 60% ±

Excel 2013
Спасибо большое ЮДик.
 
Ответить
СообщениеСпасибо большое ЮДик.

Автор - cobra77777
Дата добавления - 12.07.2017 в 20:06
AndreTM Дата: Среда, 12.07.2017, 20:18 | Сообщение № 11
Группа: Друзья
Ранг: Старожил
Сообщений: 1540
Репутация: 444 ±
Замечаний: 0% ±

2003 & 2010
В дополнение: не знаю насколько "много программ вы пробовали", но я иногда для выполнения подобных задач использую Advanced Find and Replace. Вполне вменяемая утилита, если немного разобраться, тем более, с поддержкой RegEx.


Donate: Qiwi: 9517375010
 
Ответить
СообщениеВ дополнение: не знаю насколько "много программ вы пробовали", но я иногда для выполнения подобных задач использую Advanced Find and Replace. Вполне вменяемая утилита, если немного разобраться, тем более, с поддержкой RegEx.

Автор - AndreTM
Дата добавления - 12.07.2017 в 20:18
RAN Дата: Четверг, 13.07.2017, 00:07 | Сообщение № 12
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4477
Репутация: 905 ±
Замечаний: 0% ±

2010
Так что первоочередной вопрос

Udik, сам переводил, а не пользуешся.
[vba]
Код
Sub Мяу()
    Dim arr() As String, s As String, i As Integer
    Dim ss As String
    s = "C:\Users\OFIS\Documents\!!\00367304.173"
    With CreateObject("ADODB.Stream")
        .Type = 2
        .Mode = 3
        .Charset = "CP866"     'исходная кодировка
        .Open
        .LoadFromFile s
        ss = .ReadText
        arr = Split(ss, vbCrLf)
        For i = 0 To UBound(arr)
            arr(i) = arr(i) & " Мяу"
        Next i
        ss = Join(arr, vbCrLf)
        .Position = 0
        .WriteText ss
        .SaveToFile "C:\Users\OFIS\Documents\!!\003673041.173", 2
        .Close
    End With
End Sub
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
Так что первоочередной вопрос

Udik, сам переводил, а не пользуешся.
[vba]
Код
Sub Мяу()
    Dim arr() As String, s As String, i As Integer
    Dim ss As String
    s = "C:\Users\OFIS\Documents\!!\00367304.173"
    With CreateObject("ADODB.Stream")
        .Type = 2
        .Mode = 3
        .Charset = "CP866"     'исходная кодировка
        .Open
        .LoadFromFile s
        ss = .ReadText
        arr = Split(ss, vbCrLf)
        For i = 0 To UBound(arr)
            arr(i) = arr(i) & " Мяу"
        Next i
        ss = Join(arr, vbCrLf)
        .Position = 0
        .WriteText ss
        .SaveToFile "C:\Users\OFIS\Documents\!!\003673041.173", 2
        .Close
    End With
End Sub
[/vba]

Автор - RAN
Дата добавления - 13.07.2017 в 00:07
cobra77777 Дата: Четверг, 13.07.2017, 09:34 | Сообщение № 13
Группа: Пользователи
Ранг: Участник
Сообщений: 51
Репутация: 0 ±
Замечаний: 60% ±

Excel 2013
Стоит 2013 офис. Попробовал код указанный выше выдаёт ошибку:
Compile errror. Expected End With.
Можно как то исправить ?
 
Ответить
СообщениеСтоит 2013 офис. Попробовал код указанный выше выдаёт ошибку:
Compile errror. Expected End With.
Можно как то исправить ?

Автор - cobra77777
Дата добавления - 13.07.2017 в 09:34
Udik Дата: Четверг, 13.07.2017, 12:01 | Сообщение № 14
Группа: Друзья
Ранг: Старожил
Сообщений: 1493
Репутация: 184 ±
Замечаний: 0% ±

Excel 2016 х 64
Udik, сам переводил, а не пользуешся.

чукча не читатель :p


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
Сообщение
Udik, сам переводил, а не пользуешся.

чукча не читатель :p

Автор - Udik
Дата добавления - 13.07.2017 в 12:01
Udik Дата: Четверг, 13.07.2017, 12:04 | Сообщение № 15
Группа: Друзья
Ранг: Старожил
Сообщений: 1493
Репутация: 184 ±
Замечаний: 0% ±

Excel 2016 х 64
Compile errror. Expected End With.

дык пишет же, что нету End With
Проверьте, может затерялось при копировании


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
Сообщение
Compile errror. Expected End With.

дык пишет же, что нету End With
Проверьте, может затерялось при копировании

Автор - Udik
Дата добавления - 13.07.2017 в 12:04
cobra77777 Дата: Четверг, 13.07.2017, 12:12 | Сообщение № 16
Группа: Пользователи
Ранг: Участник
Сообщений: 51
Репутация: 0 ±
Замечаний: 60% ±

Excel 2013
да, точно.
Udik, а моим вопросом не занимались?
 
Ответить
Сообщениеда, точно.
Udik, а моим вопросом не занимались?

Автор - cobra77777
Дата добавления - 13.07.2017 в 12:12
Udik Дата: Четверг, 13.07.2017, 12:50 | Сообщение № 17
Группа: Друзья
Ранг: Старожил
Сообщений: 1493
Репутация: 184 ±
Замечаний: 0% ±

Excel 2016 х 64
Ну вот совместно с кодом RAN,
[vba]
Код

Public Sub main()
Dim sFolder As String, sFiles As String, str1$
Dim arr() As String, s As String, i As Integer
Dim ss As String
Dim RegExp
Dim strKav As String, str2$, str3$
Dim arrStr

    strKav = Chr(34)
    str2 = strKav & "ООО ТРС" & strKav
    str3 = strKav & "ООО ЗВЕЗДА" & strKav

    Set RegExp = CreateObject("VBScript.RegExp")
     With RegExp
        .Global = True 'Нужны все совпадения
        .IgnoreCase = True 'Регистр неважен
        .Pattern = strKav & "ООО.+?" & strKav
    End With
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    'отключаем обновление экрана, чтобы наши действия не мелькали
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.txt*")
     Do While sFiles <> ""
     
        s = sFolder & sFiles
        Application.StatusBar = "Processing file: " & sFiles
         With CreateObject("ADODB.Stream")
            .Type = 2
            .Mode = 3
            .Charset = "CP866"     'исходная кодировка
            .Open
            .LoadFromFile s
            
            ss = .ReadText
            arr = Split(ss, vbCrLf)
            
            For i = 0 To UBound(arr)
                str1 = arr(i)
                str1 = RegExp.Replace(str1, str3)
                arrStr = Split(str1, ",")
                If UBound(arrStr) > 0 Then
                    str1 = Replace(str1, arrStr(0), "", 1, 1)
                    str1 = arrStr(0) & "," & str2 & str1
                End If
                arr(i) = str1
            Next i
            
            ss = Join(arr, vbCrLf)
            .Position = 0
            .WriteText ss
            .SaveToFile s, 2
            .Close
        End With
        sFiles = Dir

    Loop
    Application.ScreenUpdating = True

End Sub

[/vba]
К сообщению приложен файл: 7044130.xlsm(19Kb)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
СообщениеНу вот совместно с кодом RAN,
[vba]
Код

Public Sub main()
Dim sFolder As String, sFiles As String, str1$
Dim arr() As String, s As String, i As Integer
Dim ss As String
Dim RegExp
Dim strKav As String, str2$, str3$
Dim arrStr

    strKav = Chr(34)
    str2 = strKav & "ООО ТРС" & strKav
    str3 = strKav & "ООО ЗВЕЗДА" & strKav

    Set RegExp = CreateObject("VBScript.RegExp")
     With RegExp
        .Global = True 'Нужны все совпадения
        .IgnoreCase = True 'Регистр неважен
        .Pattern = strKav & "ООО.+?" & strKav
    End With
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    'отключаем обновление экрана, чтобы наши действия не мелькали
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.txt*")
     Do While sFiles <> ""
     
        s = sFolder & sFiles
        Application.StatusBar = "Processing file: " & sFiles
         With CreateObject("ADODB.Stream")
            .Type = 2
            .Mode = 3
            .Charset = "CP866"     'исходная кодировка
            .Open
            .LoadFromFile s
            
            ss = .ReadText
            arr = Split(ss, vbCrLf)
            
            For i = 0 To UBound(arr)
                str1 = arr(i)
                str1 = RegExp.Replace(str1, str3)
                arrStr = Split(str1, ",")
                If UBound(arrStr) > 0 Then
                    str1 = Replace(str1, arrStr(0), "", 1, 1)
                    str1 = arrStr(0) & "," & str2 & str1
                End If
                arr(i) = str1
            Next i
            
            ss = Join(arr, vbCrLf)
            .Position = 0
            .WriteText ss
            .SaveToFile s, 2
            .Close
        End With
        sFiles = Dir

    Loop
    Application.ScreenUpdating = True

End Sub

[/vba]

Автор - Udik
Дата добавления - 13.07.2017 в 12:50
cobra77777 Дата: Четверг, 13.07.2017, 13:43 | Сообщение № 18
Группа: Пользователи
Ранг: Участник
Сообщений: 51
Репутация: 0 ±
Замечаний: 60% ±

Excel 2013
Какие переменные нужно поменять чтобы скрипт заработал ?


Сообщение отредактировал cobra77777 - Четверг, 13.07.2017, 19:40
 
Ответить
СообщениеКакие переменные нужно поменять чтобы скрипт заработал ?

Автор - cobra77777
Дата добавления - 13.07.2017 в 13:43
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Необходимо массово заменить текст в файлах (VBA)? (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!