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

Вход

Регистрация

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

 

= Мир MS Excel/Открытие всех книг в заданной папке с внесением изменений - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Открытие всех книг в заданной папке с внесением изменений (Макросы/Sub)
Открытие всех книг в заданной папке с внесением изменений
miha_ Дата: Вторник, 30.07.2019, 23:36 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Добрый вечер, форумчане.
Подскажите пожалуйста, в чём ошибка в коде, почему он не выполняет свои задачи?))
Что я сделал не так? Макрос, должен последовательно открывать все файлы с разрешением .csv в указанной папке, вносить изменения, сохранить файл и закрыть его.Так циклично пока все файлы в папке не будут обработаны.
[vba]
Код
Private Sub Open_Workbooks()

Const iPath$ = "C:\Users\User\Desktop\09\месяца\Новая папка"
iFileName$ = Dir(iPath$ & "*.csv")
Do While iFileName$ <> ""
              Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
        33, 1), Array(34, 1)), TrailingMinusNumbers:=True
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:23").Select
    Selection.Delete Shift:=xlUp
    Columns("B:R").Select
    Selection.Delete Shift:=xlToLeft
    Range("C1").Select
    Selection.AutoFill Destination:=Range("B1:C1"), Type:=xlFillDefault
    Range("B1:C1").Select
    Columns("C:K").Select
    Selection.Delete Shift:=xlToLeft
     

   iFileName$ = Dir
Loop
End Sub
[/vba]

Спасибо.
К сообщению приложен файл: 3042254.xlsm (21.0 Kb)


Сообщение отредактировал miha_ - Вторник, 30.07.2019, 23:36
 
Ответить
СообщениеДобрый вечер, форумчане.
Подскажите пожалуйста, в чём ошибка в коде, почему он не выполняет свои задачи?))
Что я сделал не так? Макрос, должен последовательно открывать все файлы с разрешением .csv в указанной папке, вносить изменения, сохранить файл и закрыть его.Так циклично пока все файлы в папке не будут обработаны.
[vba]
Код
Private Sub Open_Workbooks()

Const iPath$ = "C:\Users\User\Desktop\09\месяца\Новая папка"
iFileName$ = Dir(iPath$ & "*.csv")
Do While iFileName$ <> ""
              Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
        33, 1), Array(34, 1)), TrailingMinusNumbers:=True
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:23").Select
    Selection.Delete Shift:=xlUp
    Columns("B:R").Select
    Selection.Delete Shift:=xlToLeft
    Range("C1").Select
    Selection.AutoFill Destination:=Range("B1:C1"), Type:=xlFillDefault
    Range("B1:C1").Select
    Columns("C:K").Select
    Selection.Delete Shift:=xlToLeft
     

   iFileName$ = Dir
Loop
End Sub
[/vba]

Спасибо.

Автор - miha_
Дата добавления - 30.07.2019 в 23:36
wild_pig Дата: Среда, 31.07.2019, 00:01 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 517
Репутация: 97 ±
Замечаний: 0% ±

2003, 2013
Где csv файл? Что с ним надо сделать?
 
Ответить
СообщениеГде csv файл? Что с ним надо сделать?

Автор - wild_pig
Дата добавления - 31.07.2019 в 00:01
miha_ Дата: Среда, 31.07.2019, 00:10 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
wild_pig, нужно преобразовать в таблицу и удалить ненужные строки.
Вот код, который это всё делает.
Работает отлично, с своей задачей справляется. Все файлы для преобразования имеют одинаковую структуру.
Проблема, с моим кодом в том, что не открываются книги по указанному пути и не запускается код преобразования файла.
[vba]
Код
Sub преобразование()

    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
        33, 1), Array(34, 1)), TrailingMinusNumbers:=True
    Rows("1:23").Select
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:R").Select
    Selection.Delete Shift:=xlToLeft
    Range("C1").Select
    Selection.AutoFill Destination:=Range("B1:C1"), Type:=xlFillDefault
    Range("B1:C1").Select
    Columns("C:K").Select
    Selection.Delete Shift:=xlToLeft
End Sub
[/vba]


Сообщение отредактировал miha_ - Среда, 31.07.2019, 00:10
 
Ответить
Сообщениеwild_pig, нужно преобразовать в таблицу и удалить ненужные строки.
Вот код, который это всё делает.
Работает отлично, с своей задачей справляется. Все файлы для преобразования имеют одинаковую структуру.
Проблема, с моим кодом в том, что не открываются книги по указанному пути и не запускается код преобразования файла.
[vba]
Код
Sub преобразование()

    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
        33, 1), Array(34, 1)), TrailingMinusNumbers:=True
    Rows("1:23").Select
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:R").Select
    Selection.Delete Shift:=xlToLeft
    Range("C1").Select
    Selection.AutoFill Destination:=Range("B1:C1"), Type:=xlFillDefault
    Range("B1:C1").Select
    Columns("C:K").Select
    Selection.Delete Shift:=xlToLeft
End Sub
[/vba]

Автор - miha_
Дата добавления - 31.07.2019 в 00:10
wild_pig Дата: Среда, 31.07.2019, 00:14 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 517
Репутация: 97 ±
Замечаний: 0% ±

2003, 2013
не открываются книги по указанному пути и не запускается код преобразования файла

Скорее всего книги открывать надо, а не только имена перебирать. Ну и сохранять соответственно.


Сообщение отредактировал wild_pig - Среда, 31.07.2019, 00:16
 
Ответить
Сообщение
не открываются книги по указанному пути и не запускается код преобразования файла

Скорее всего книги открывать надо, а не только имена перебирать. Ну и сохранять соответственно.

Автор - wild_pig
Дата добавления - 31.07.2019 в 00:14
wild_pig Дата: Среда, 31.07.2019, 00:30 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 517
Репутация: 97 ±
Замечаний: 0% ±

2003, 2013
[vba]
Код
'открываем
Workbooks.OpenText путь_к_файлу, local:=True
'сохраняем
ActiveWorkbook.SaveAs Filename:=путь_к_файлу, FileFormat:=xlCSV, CreateBackup:=False, local:=True
[/vba]
Как-то так, не помню точно, но есть поиск.
 
Ответить
Сообщение[vba]
Код
'открываем
Workbooks.OpenText путь_к_файлу, local:=True
'сохраняем
ActiveWorkbook.SaveAs Filename:=путь_к_файлу, FileFormat:=xlCSV, CreateBackup:=False, local:=True
[/vba]
Как-то так, не помню точно, но есть поиск.

Автор - wild_pig
Дата добавления - 31.07.2019 в 00:30
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Открытие всех книг в заданной папке с внесением изменений (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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