Страницы: 1
RSS
Макрос по замене текста в файлах выбранной папки
 
добрый день. появилась необходимость сделать замену названий столбов в файлах (файлов очень много, находятся в одной папке). Данные, которые нужно заменить расположены в одном и том же листе с названием "ItemDetails" во всех файлах. попробовал записать макрос для нахождения и замены вкроде как работает.
Код
Sub replacetext()

    ActiveCell.Replace What:="GR Document number", Replacement:= _
        "Capitalization.GR Document number", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="GR Document number", Replacement:= _
        "Capitalization.GR Document number", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="Evaluation Code", Replacement:= _
        "Capitalization.Evaluation Code", LookAt:=xlPart, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="Asset Class", Replacement:= _
        "Capitalization.Asset Class", LookAt:=xlPart, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="Cost Center", Replacement:= _
        "Capitalization.Cost Center", LookAt:=xlPart, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

подскажите, как дописать сюда код, который будет запрашивать папку с расположением файла, открывать файлы по очереди, изменять данные только на листе ItemDetails, сохранять и закрывать файлы в фоне. Откывать файлы и запускать макрос в ручном режиме даже страшно подумать :) зарене спасибо!
Опыт и практика - великое дело! Век живи, Век учись!
 
ПРОСМОТРЕТЬ ВСЕ ФАЙЛЫ В ПАПКЕ
Скрытый текст
Изменено: Sanja - 12.07.2019 06:43:19
Согласие есть продукт при полном непротивлении сторон
 
тоже закину найденный макрос. вроде работает. меняет значения в диапазоне a1:bb10 в книгах .xlsx
Код
Sub ЗаменаНаЛистеВсехКниг()
Dim Wb As Workbook              'текущая книга ( где исполняемый код)
Dim tWb As Workbook             'открываемая книга
Dim ShtOut As Worksheet         'лист в текущей книге
Dim ShtIn As Worksheet          'лист в открываемом файле
Dim iTempFileName As String     'имя очерёдного открываемого файла
Dim iPath As String             'путь к папке, где лежат все файлы
Dim iNumFiles As Long           'количество открываемых файлов
Dim FD As FileDialog
Dim i As Long
Application.ScreenUpdating = False
 
     '      iPath = Range("A15").Value
            iPath = "C:\Documents\"
 
 
    Set Wb = ThisWorkbook       'эта книга
    iNumFiles = 0
    On Error GoTo ErrHandler 
    iTempFileName = Dir(iPath & "*.xlsx")     
    Do While iTempFileName <> ""
        iNumFiles = iNumFiles + 1       
        Set tWb = Workbooks.Open(Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=False)        
        'В СтатусБаре отображаем имя открываемого файла
        Application.StatusBar = "Обработка файла: " & tWb.Name         
      Sheets("ItemDetails").Select
For Each cc In [a1:bb10]
If cc.Value = "GR Document number" Then cc.Value = "Capitalization.GR Document number"
If cc.Value = "Evaluation Code" Then cc.Value = "Capitalization.Evaluation Code"
If cc.Value = "Asset Class" Then cc.Value = "Capitalization.Asset Class"
If cc.Value = "Cost Center" Then cc.Value = "Capitalization.Cost Center"
Next
        tWb.Close SaveChanges:=True         'закрыть книгу с сохранением изменений
        iTempFileName = Dir                 'следующая книга для внесения изменений
        Set ShtIn = Nothing                 'обнуляем переменную после закрытия книги
    Loop
    Application.StatusBar = False    'сбрасываем СтатусБар     
    MsgBox "Изменения произведены в " & iNumFiles & " файлах в папке: " & Chr(10) & iPath, vbInformation, "Конец"
    Exit Sub 
ErrHandler:
    MsgBox "Произошла ошибка!", 48, "Ошибка"
 
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
 
Sanja, Круто! Все работает! а можно ли в этот код добавить добавление новых столбцов по аналогии с массивом
Код
 addArr = Array("column 1", "column 2", "column 3")
в конец таблицы (после последнего столбца, например).
Опыт и практика - великое дело! Век живи, Век учись!
 
Можно
Скрытый текст
Согласие есть продукт при полном непротивлении сторон
 
Sanja, спасибо Вам огромное!!!!!
Опыт и практика - великое дело! Век живи, Век учись!
Страницы: 1
Наверх