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

Вход

Регистрация

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

 

= Мир MS Excel/Выборка из нескольких файлов - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выборка из нескольких файлов (Макросы Sub)
Выборка из нескольких файлов
Алексей Дата: Воскресенье, 11.08.2013, 23:25 | Сообщение № 1
Группа: Гости
Помогите пожалуйста.
Есть папка с файлами excel. Названия файлов "Книга №1 о том", "Книга №2 о сем" и т.д. В этих файлах на одних и тех же ячейках находятся данные.
Я хочу написать макрос чтобы он открывал книги по порядку и данные из нужных мне ячеек заносил в общую таблицу.
Подскажите как мне сделать переменную обращения к книгам типа x = ["Книга№"x1"*".xls] чтобы загнать ее в цикл и меняя x1 перебрать все файлы в папке.
 
Ответить
СообщениеПомогите пожалуйста.
Есть папка с файлами excel. Названия файлов "Книга №1 о том", "Книга №2 о сем" и т.д. В этих файлах на одних и тех же ячейках находятся данные.
Я хочу написать макрос чтобы он открывал книги по порядку и данные из нужных мне ячеек заносил в общую таблицу.
Подскажите как мне сделать переменную обращения к книгам типа x = ["Книга№"x1"*".xls] чтобы загнать ее в цикл и меняя x1 перебрать все файлы в папке.
Автор - Алексей
Дата добавления - 11.08.2013 в 23:25
SergeyKorotun Дата: Воскресенье, 11.08.2013, 23:35 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 301
Репутация: 15 ±
Замечаний: 0% ±

Excel 2007
[vba]
Код
Sub namefile()
      Dim x As String
      Dim x1 As Long
      For x1 = 1 To 10
          x = "Книга№" & CStr(x1) & "*.xls"
          MsgBox (x)
      Next x1
End Sub
[/vba]


Сообщение отредактировал SergeyKorotun - Воскресенье, 11.08.2013, 23:50
 
Ответить
Сообщение[vba]
Код
Sub namefile()
      Dim x As String
      Dim x1 As Long
      For x1 = 1 To 10
          x = "Книга№" & CStr(x1) & "*.xls"
          MsgBox (x)
      Next x1
End Sub
[/vba]
Автор - SergeyKorotun
Дата добавления - 11.08.2013 в 23:35
Алексей Дата: Понедельник, 12.08.2013, 08:41 | Сообщение № 3
Группа: Гости
У меня получилось так:

[vba]
Код
Sub Подготовка1()

Dim x As String
Dim x1 As Long
Dim i As Single

x1 = 1
i = 4

ChDir "C:\Users\acer\Desktop\2013\"
For x1 = 1 To 5
x = "№" & CStr(x1) & "*.xls"
MsgBox (x)
Range("a" & i).Value = x1
Range("b" & i).Value = _
"='[x]Лист2'!b11"
Range("c" & i).Value = _
"='[x]Лист2'!b3"
Range("d" & i).Value = _
"='[x]Лист1'!b4"
i = i + 1
Next x1
End Sub
[/vba]
Но при каждом обращении к x он выдает окно "обновить x" с папкой 2013 где я должен выбрать нужный мне файл excel вручную(то есть мне из файла надо взять значение 3 ячеек и этот файл я должен выбрать файл 4 раза, затем следующий). Как сделать чтобы он файл выбирал сам?
 
Ответить
СообщениеУ меня получилось так:

[vba]
Код
Sub Подготовка1()

Dim x As String
Dim x1 As Long
Dim i As Single

x1 = 1
i = 4

ChDir "C:\Users\acer\Desktop\2013\"
For x1 = 1 To 5
x = "№" & CStr(x1) & "*.xls"
MsgBox (x)
Range("a" & i).Value = x1
Range("b" & i).Value = _
"='[x]Лист2'!b11"
Range("c" & i).Value = _
"='[x]Лист2'!b3"
Range("d" & i).Value = _
"='[x]Лист1'!b4"
i = i + 1
Next x1
End Sub
[/vba]
Но при каждом обращении к x он выдает окно "обновить x" с папкой 2013 где я должен выбрать нужный мне файл excel вручную(то есть мне из файла надо взять значение 3 ячеек и этот файл я должен выбрать файл 4 раза, затем следующий). Как сделать чтобы он файл выбирал сам?
Автор - Алексей
Дата добавления - 12.08.2013 в 08:41
SergeyKorotun Дата: Понедельник, 12.08.2013, 15:09 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 301
Репутация: 15 ±
Замечаний: 0% ±

Excel 2007
[vba]
Код
Sub Подготовка1()

Dim x As String
Dim x1 As Long
Dim wb As Workbook
Dim i As Long

i = 4
'ChDir "C:\Users\acer\Desktop\2013\"
Application.ScreenUpdating = False
For x1 = 1 To 5
        x = "№" & CStr(x1) & "*.xls"
        'MsgBox (x)
        Set wb = Workbooks.Open("C:\Users\acer\Desktop\2013\"&x)
        ThisWorkbook.Worksheets(1).Range("a" & x1+i).Value = x1
        ThisWorkbook.Worksheets(1).Range("b" & x1+i).Value = Range("b11").Value
        ThisWorkbook.Worksheets(1).Range("c" & x1+i).Value = Range("b3").Value
        ThisWorkbook.Worksheets(1).Range("d" & x1+i).Value = Range("b4").Value
        wb.Close
Next x1
Application.ScreenUpdating = True
End Sub
[/vba]


Сообщение отредактировал SergeyKorotun - Вторник, 13.08.2013, 00:37
 
Ответить
Сообщение[vba]
Код
Sub Подготовка1()

Dim x As String
Dim x1 As Long
Dim wb As Workbook
Dim i As Long

i = 4
'ChDir "C:\Users\acer\Desktop\2013\"
Application.ScreenUpdating = False
For x1 = 1 To 5
        x = "№" & CStr(x1) & "*.xls"
        'MsgBox (x)
        Set wb = Workbooks.Open("C:\Users\acer\Desktop\2013\"&x)
        ThisWorkbook.Worksheets(1).Range("a" & x1+i).Value = x1
        ThisWorkbook.Worksheets(1).Range("b" & x1+i).Value = Range("b11").Value
        ThisWorkbook.Worksheets(1).Range("c" & x1+i).Value = Range("b3").Value
        ThisWorkbook.Worksheets(1).Range("d" & x1+i).Value = Range("b4").Value
        wb.Close
Next x1
Application.ScreenUpdating = True
End Sub
[/vba]
Автор - SergeyKorotun
Дата добавления - 12.08.2013 в 15:09
RAN Дата: Понедельник, 12.08.2013, 19:03 | Сообщение № 5
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
SergeyKorotun,
Может я и не прав ( пусть старшие товарищи поправят), но
Set wb = Workbooks.Open
предполагает ПОЛНЫЙ путь к файлу, а не к папке, где этот файл лежит.
Алексей,
Леха, Леха,
без файла все так плёхо!... :(

Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеSergeyKorotun,
Может я и не прав ( пусть старшие товарищи поправят), но
Set wb = Workbooks.Open
предполагает ПОЛНЫЙ путь к файлу, а не к папке, где этот файл лежит.
Алексей,
Леха, Леха,
без файла все так плёхо!... :(
Автор - RAN
Дата добавления - 12.08.2013 в 19:03
Алексей Дата: Понедельник, 12.08.2013, 23:24 | Сообщение № 6
Группа: Гости
Да, так и есть, это путь к файлу а не к папке. RAN прав.
Программа ругается, что файла C:\Users\acer\Desktop\2013\ не существует.
 
Ответить
СообщениеДа, так и есть, это путь к файлу а не к папке. RAN прав.
Программа ругается, что файла C:\Users\acer\Desktop\2013\ не существует.
Автор - Алексей
Дата добавления - 12.08.2013 в 23:24
SergeyKorotun Дата: Вторник, 13.08.2013, 00:14 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 301
Репутация: 15 ±
Замечаний: 0% ±

Excel 2007
Цитата (RAN, 12.08.2013 в 19:03, в сообщении №5)
Set wb = Workbooks.Open
предполагает ПОЛНЫЙ путь к файлу, а не к папке, где этот файл лежит.

Поправил. Когда писал макрос, имя файла было, а потом когда заменял свой путь на путь автора, случайно стер имя файла
 
Ответить
Сообщение
Цитата (RAN, 12.08.2013 в 19:03, в сообщении №5)
Set wb = Workbooks.Open
предполагает ПОЛНЫЙ путь к файлу, а не к папке, где этот файл лежит.

Поправил. Когда писал макрос, имя файла было, а потом когда заменял свой путь на путь автора, случайно стер имя файла
Автор - SergeyKorotun
Дата добавления - 13.08.2013 в 00:14
Алексей Дата: Вторник, 13.08.2013, 08:00 | Сообщение № 8
Группа: Гости
Опять не работает.)))
Он ищет именно C:\Users\acer\Desktop\2013\№1*.xls, а вместо "*" у каждого файла свое имя.
 
Ответить
СообщениеОпять не работает.)))
Он ищет именно C:\Users\acer\Desktop\2013\№1*.xls, а вместо "*" у каждого файла свое имя.
Автор - Алексей
Дата добавления - 13.08.2013 в 08:00
SergeyKorotun Дата: Вторник, 13.08.2013, 12:07 | Сообщение № 9
Группа: Проверенные
Ранг: Обитатель
Сообщений: 301
Репутация: 15 ±
Замечаний: 0% ±

Excel 2007
В этой строке "*" замените на то, что вам нужно и прочитайте еще раз сообщение №5
[vba]
Код
x = "№" & CStr(x1) & "*.xls"
[/vba]
 
Ответить
СообщениеВ этой строке "*" замените на то, что вам нужно и прочитайте еще раз сообщение №5
[vba]
Код
x = "№" & CStr(x1) & "*.xls"
[/vba]
Автор - SergeyKorotun
Дата добавления - 13.08.2013 в 12:07
Алексей Дата: Вторник, 13.08.2013, 16:04 | Сообщение № 10
Группа: Гости
"*" это в каждом случае разный текст. Пимеры:
№1-2013 Алексей.xls
№2-2013 Иван Петрович.xls
№3 Федор(предоплата).xls
№4-Сергею до 11_03_13.xls и т. д.
Я думал весь текст за номером получиться заменить звездочкой. Как при поиске в виндовозе.
Весь смысл в переборе файлов не смотря на названия.
[moder]Вам уже дважды писали о том, что нужно приложить файл. Еще одно сообщение без файла и я заблокирую Ваш IP-шник
 
Ответить
Сообщение"*" это в каждом случае разный текст. Пимеры:
№1-2013 Алексей.xls
№2-2013 Иван Петрович.xls
№3 Федор(предоплата).xls
№4-Сергею до 11_03_13.xls и т. д.
Я думал весь текст за номером получиться заменить звездочкой. Как при поиске в виндовозе.
Весь смысл в переборе файлов не смотря на названия.
[moder]Вам уже дважды писали о том, что нужно приложить файл. Еще одно сообщение без файла и я заблокирую Ваш IP-шник
Автор - Алексей
Дата добавления - 13.08.2013 в 16:04
Алексей33 Дата: Вторник, 13.08.2013, 17:23 | Сообщение № 11
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Извиняюсь.
Прикрепляю файл образец и файл болванку с макросом.
К сообщению приложен файл: 1674070.xlsm (18.4 Kb) · 1-2013_.xls (80.5 Kb)
 
Ответить
СообщениеИзвиняюсь.
Прикрепляю файл образец и файл болванку с макросом.
Автор - Алексей33
Дата добавления - 13.08.2013 в 17:23
SergeyKorotun Дата: Вторник, 13.08.2013, 19:13 | Сообщение № 12
Группа: Проверенные
Ранг: Обитатель
Сообщений: 301
Репутация: 15 ±
Замечаний: 0% ±

Excel 2007
В приложенном файле в имени уже нет "№"
Нет времени на тестирование. Попробуйте так.
[vba]
Код

Sub Подготовка1()
Dim x As String
Dim x1 As Long
Dim wb As Workbook
Dim i As Long
i = 4
'ChDir "C:\Users\acer\Desktop\2013\"
Application.ScreenUpdating = False
For x1 = 1 To 5
           x = "№" & CStr(x1) & "*.xls"
           'MsgBox (x)
           Set wb = Workbooks.Open("C:\Users\acer\Desktop\2013\" & Dir("C:\Users\acer\Desktop\2013\" & x))
           ThisWorkbook.Worksheets(1).Range("a" & x1+i).Value = x1
           ThisWorkbook.Worksheets(1).Range("b" & x1+i).Value = Range("b11").Value
           ThisWorkbook.Worksheets(1).Range("c" & x1+i).Value = Range("b3").Value
           ThisWorkbook.Worksheets(1).Range("d" & x1+i).Value = Range("b4").Value
           wb.Close
Next x1
Application.ScreenUpdating = True
End Sub
[/vba]


Сообщение отредактировал SergeyKorotun - Вторник, 13.08.2013, 19:53
 
Ответить
СообщениеВ приложенном файле в имени уже нет "№"
Нет времени на тестирование. Попробуйте так.
[vba]
Код

Sub Подготовка1()
Dim x As String
Dim x1 As Long
Dim wb As Workbook
Dim i As Long
i = 4
'ChDir "C:\Users\acer\Desktop\2013\"
Application.ScreenUpdating = False
For x1 = 1 To 5
           x = "№" & CStr(x1) & "*.xls"
           'MsgBox (x)
           Set wb = Workbooks.Open("C:\Users\acer\Desktop\2013\" & Dir("C:\Users\acer\Desktop\2013\" & x))
           ThisWorkbook.Worksheets(1).Range("a" & x1+i).Value = x1
           ThisWorkbook.Worksheets(1).Range("b" & x1+i).Value = Range("b11").Value
           ThisWorkbook.Worksheets(1).Range("c" & x1+i).Value = Range("b3").Value
           ThisWorkbook.Worksheets(1).Range("d" & x1+i).Value = Range("b4").Value
           wb.Close
Next x1
Application.ScreenUpdating = True
End Sub
[/vba]
Автор - SergeyKorotun
Дата добавления - 13.08.2013 в 19:13
SergeyKorotun Дата: Вторник, 13.08.2013, 20:52 | Сообщение № 13
Группа: Проверенные
Ранг: Обитатель
Сообщений: 301
Репутация: 15 ±
Замечаний: 0% ±

Excel 2007
[vba]
Код
Sub Podgotovka1()
     Dim x As String
     Dim x1 As Long
     Dim wb As Workbook
     Dim i As Long
     i = 4
     Ch_Dir = "C:\Users\acer\Desktop\2013\"
     Application.ScreenUpdating = False
     x1 = 1
     x = "№*.xls"
     nmfile = Dir(Ch_Dir & x)
     pthname = Ch_Dir + nmfile
     MsgBox (pthname)

     Do While nmfile <> ""
        nmfile = Dir()
        pthname = Ch_Dir + nmfile
        x1 = x1 + 1
        If nmfile <> "" Then
           MsgBox (pthname)
           Set wb = Workbooks.Open(pthname)
           ThisWorkbook.Worksheets(1).Range("a" & x1 + i).Value = x1
           ThisWorkbook.Worksheets(1).Range("b" & x1 + i).Value = Range("b11").Value
           ThisWorkbook.Worksheets(1).Range("c" & x1 + i).Value = Range("b3").Value
           ThisWorkbook.Worksheets(1).Range("d" & x1 + i).Value = Range("b4").Value
           Application.DisplayAlerts = False
           wb.Close
           Application.DisplayAlerts = True
       End If
     Loop
     Application.ScreenUpdating = True
End Sub
[/vba]


Сообщение отредактировал SergeyKorotun - Вторник, 13.08.2013, 21:40
 
Ответить
Сообщение[vba]
Код
Sub Podgotovka1()
     Dim x As String
     Dim x1 As Long
     Dim wb As Workbook
     Dim i As Long
     i = 4
     Ch_Dir = "C:\Users\acer\Desktop\2013\"
     Application.ScreenUpdating = False
     x1 = 1
     x = "№*.xls"
     nmfile = Dir(Ch_Dir & x)
     pthname = Ch_Dir + nmfile
     MsgBox (pthname)

     Do While nmfile <> ""
        nmfile = Dir()
        pthname = Ch_Dir + nmfile
        x1 = x1 + 1
        If nmfile <> "" Then
           MsgBox (pthname)
           Set wb = Workbooks.Open(pthname)
           ThisWorkbook.Worksheets(1).Range("a" & x1 + i).Value = x1
           ThisWorkbook.Worksheets(1).Range("b" & x1 + i).Value = Range("b11").Value
           ThisWorkbook.Worksheets(1).Range("c" & x1 + i).Value = Range("b3").Value
           ThisWorkbook.Worksheets(1).Range("d" & x1 + i).Value = Range("b4").Value
           Application.DisplayAlerts = False
           wb.Close
           Application.DisplayAlerts = True
       End If
     Loop
     Application.ScreenUpdating = True
End Sub
[/vba]
Автор - SergeyKorotun
Дата добавления - 13.08.2013 в 20:52
Алексей33 Дата: Вторник, 13.08.2013, 21:20 | Сообщение № 14
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Спасибо огромное!!!
Все заработало, только в каждом файле, что обработал макрос, excel предлагает сохранить изменения.
Я дописал в цикле "wb.Save". Притормаживает, но работает.
Еще раз спасибо!
 
Ответить
СообщениеСпасибо огромное!!!
Все заработало, только в каждом файле, что обработал макрос, excel предлагает сохранить изменения.
Я дописал в цикле "wb.Save". Притормаживает, но работает.
Еще раз спасибо!
Автор - Алексей33
Дата добавления - 13.08.2013 в 21:20
SergeyKorotun Дата: Вторник, 13.08.2013, 21:46 | Сообщение № 15
Группа: Проверенные
Ранг: Обитатель
Сообщений: 301
Репутация: 15 ±
Замечаний: 0% ±

Excel 2007
Application.DisplayAlerts = False должно подавлять подобные предложения.
У меня, хотя и не на ваших таблицах, никаких запросов на сохранение не выскакивает.
 
Ответить
СообщениеApplication.DisplayAlerts = False должно подавлять подобные предложения.
У меня, хотя и не на ваших таблицах, никаких запросов на сохранение не выскакивает.
Автор - SergeyKorotun
Дата добавления - 13.08.2013 в 21:46
Алексей33 Дата: Вторник, 13.08.2013, 22:19 | Сообщение № 16
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
14 сообщение относилось к 12 не тестированному.
Да, в версии 13 все работает отлично. Она даже прощает наши косяки (у нас было несколько файлов с именем №5) программа все обработала корректно.
Но выдает запрос при обработке каждого файла(картинка прикреплена). Держу Enter 2 минуты и таблица готова)))).
Еще раз спасибо. Без Вас бы не справился, 9 лет с Политеха VBA в глаза не видел, а тут понадобилось.
К сообщению приложен файл: 0795236.jpg (46.9 Kb)
 
Ответить
Сообщение14 сообщение относилось к 12 не тестированному.
Да, в версии 13 все работает отлично. Она даже прощает наши косяки (у нас было несколько файлов с именем №5) программа все обработала корректно.
Но выдает запрос при обработке каждого файла(картинка прикреплена). Держу Enter 2 минуты и таблица готова)))).
Еще раз спасибо. Без Вас бы не справился, 9 лет с Политеха VBA в глаза не видел, а тут понадобилось.
Автор - Алексей33
Дата добавления - 13.08.2013 в 22:19
KuklP Дата: Вторник, 13.08.2013, 22:20 | Сообщение № 17
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Цитата (Алексей33, 13.08.2013 в 21:20, в сообщении №14)
excel предлагает сохранить изменения.

Чтоб не предлагал, пишите:
wb.Close 0 (без сохранения)
или
wb.Close -1 (с сохранением)

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
Сообщение
Цитата (Алексей33, 13.08.2013 в 21:20, в сообщении №14)
excel предлагает сохранить изменения.

Чтоб не предлагал, пишите:
wb.Close 0 (без сохранения)
или
wb.Close -1 (с сохранением)
Автор - KuklP
Дата добавления - 13.08.2013 в 22:20
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выборка из нескольких файлов (Макросы Sub)
  • Страница 1 из 1
  • 1
Поиск:

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