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

Регистрация

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

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

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Выборка из нескольких файлов (Макросы Sub)

Выборка из нескольких файлов

Дата: Воскресенье, 11.08.2013, 23:25 | Сообщение № 1

Группа: Гости

Помогите пожалуйста.
Есть папка с файлами excel. Названия файлов "Книга №1 о том", "Книга №2 о сем" и т.д. В этих файлах на одних и тех же ячейках находятся данные.
Я хочу написать макрос чтобы он открывал книги по порядку и данные из нужных мне ячеек заносил в общую таблицу.
Подскажите как мне сделать переменную обращения к книгам типа x = ["Книга№"x1"*".xls] чтобы загнать ее в цикл и меняя x1 перебрать все файлы в папке.

Ответить

Дата: Воскресенье, 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

Ответить

Дата: Понедельник, 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 раза, затем следующий). Как сделать чтобы он файл выбирал сам?

Ответить

Дата: Понедельник, 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

Ответить

Дата: Понедельник, 12.08.2013, 19:03 | Сообщение № 5

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

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

Быть или не быть, вот в чем загвоздка!

Ответить

Дата: Понедельник, 12.08.2013, 23:24 | Сообщение № 6

Группа: Гости

Да, так и есть, это путь к файлу а не к папке. RAN прав.
Программа ругается, что файла C:\Users\acer\Desktop\2013\ не существует.

Ответить

Дата: Вторник, 13.08.2013, 00:14 | Сообщение № 7

Группа: Проверенные

Ранг: Обитатель

Сообщений: 301

Репутация: 15 ±

Замечаний: 0% ±

Excel 2007

Цитата (RAN, 12.08.2013 в 19:03, в сообщении №5)

Set wb = Workbooks.Open
предполагает ПОЛНЫЙ путь к файлу, а не к папке, где этот файл лежит.

Поправил. Когда писал макрос, имя файла было, а потом когда заменял свой путь на путь автора, случайно стер имя файла

Ответить

Дата: Вторник, 13.08.2013, 08:00 | Сообщение № 8

Группа: Гости

Опять не работает.)))
Он ищет именно C:\Users\acer\Desktop\2013\№1*.xls, а вместо "*" у каждого файла свое имя.

Ответить

Дата: Вторник, 13.08.2013, 12:07 | Сообщение № 9

Группа: Проверенные

Ранг: Обитатель

Сообщений: 301

Репутация: 15 ±

Замечаний: 0% ±

Excel 2007

В этой строке "*" замените на то, что вам нужно и прочитайте еще раз сообщение №5
[vba]

Код

x = "№" & CStr(x1) & "*.xls"

[/vba]

Ответить

Дата: Вторник, 13.08.2013, 16:04 | Сообщение № 10

Группа: Гости

"*" это в каждом случае разный текст. Пимеры:
№1-2013 Алексей.xls
№2-2013 Иван Петрович.xls
№3 Федор(предоплата).xls
№4-Сергею до 11_03_13.xls и т. д.
Я думал весь текст за номером получиться заменить звездочкой. Как при поиске в виндовозе.
Весь смысл в переборе файлов не смотря на названия.
[moder]Вам уже дважды писали о том, что нужно приложить файл. Еще одно сообщение без файла и я заблокирую Ваш IP-шник

Ответить

Алексей33

Дата: Вторник, 13.08.2013, 17:23 | Сообщение № 11

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Извиняюсь.
Прикрепляю файл образец и файл болванку с макросом.

К сообщению приложен файл: 1674070.xlsm (18.4 Kb) · 1-2013_.xls (80.5 Kb)

Ответить

Дата: Вторник, 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

Ответить

Дата: Вторник, 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

Ответить

Алексей33

Дата: Вторник, 13.08.2013, 21:20 | Сообщение № 14

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Спасибо огромное!!!
Все заработало, только в каждом файле, что обработал макрос, excel предлагает сохранить изменения.
Я дописал в цикле "wb.Save". Притормаживает, но работает.
Еще раз спасибо!

Ответить

Дата: Вторник, 13.08.2013, 21:46 | Сообщение № 15

Группа: Проверенные

Ранг: Обитатель

Сообщений: 301

Репутация: 15 ±

Замечаний: 0% ±

Excel 2007

Application.DisplayAlerts = False должно подавлять подобные предложения.
У меня, хотя и не на ваших таблицах, никаких запросов на сохранение не выскакивает.

Ответить

Алексей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)

Ответить

Дата: Вторник, 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

Ответить

Выборка из нескольких файлов (Макросы Sub)

Страница 1 из 1
1

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