Хостинг портала RFpro.ru:
Московский хостер
Профессиональный платный хостинг на базе Windows 2008

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

Гуревич Александр Львович Статус: 10-й класс Рейтинг: 1022 ∙ повысить рейтинг »

Megaloman Статус: Бакалавр Рейтинг: 645 ∙ повысить рейтинг »

Botsman Статус: Специалист Рейтинг: 514 ∙ повысить рейтинг »

Вопрос № 173075: Добрый вечер уважаемые эксперты. VBA EXCEL Общая задача: в одной папке находится анкеты установленного образца и БД.xls. По задумке определённая информация из анкет(тоже xls) должна попасть в БД. Общий вопрос такой. Каким ...

Добрый вечер уважаемые эксперты.

VBA EXCEL

Общая задача:
в одной папке находится анкеты установленного образца и БД.xls. По задумке определённая информация из анкет(тоже xls) должна попасть в БД.

Общий вопрос такой.
Каким образом, по нажатию кнопки в файле БД, можно в цикле перенести определённую информацию из анкет в БД? То есть получить список имен в папке, поместить в массив и поочерёдно открывать анкеты, копировать инфо и закрывать?

Отправлен: 08.10.2009, 22:40
Вопрос задал: Соколов В.В., Посетитель
Всего ответов: 2
Страница вопроса »

Ответ отправил: Архипов Александр Леонидович, Практикант
Ответ отправлен: 09.10.2009, 10:16

Оценка ответа: 4
Комментарий к оценке:
Ответ на вопрос был получен, но не точно. Можно использовать, но не то что требовалось.

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255192 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает Megaloman, Бакалавр :
Здравствуйте, Соколов В.В.. Вот макрос, который последовательно открывает эксел-файлы по маске в указанной папке, забирает в массив значение указанных клеток, заносит их в сводную таблицу (базу), закрывает открытый макросом файл

Sub Svod()
' Исходные данные
    RabDir
= "H:\Delete\Откуда грузим"      ' Где данные для загрузки
    Maska = "*.xls"                         ' Маска имени загружаемых файлов
    
    SvodFileName = "Загрузка файлов.xls"    ' Наименование файла с базой
    ListSvod = "База"                       ' Имя листа со сводом
    
    ChDir RabDir
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Tdir = FSO
 .GetFolder(RabDir)
    Set AllFiles = Tdir.Files
    
    Dim Mass(2) As Variant
        
    Sheets(ListSvod).Select
    Columns("A:Q").ClearContents             ' Очищаю лист куда буду грузить
    Range("A1").Select
    
    i = 0
    For Each iFile In AllFiles
        jName = iFile.Name
        
        If jName Like Maska Then
            Range("A1").Offset(i, 0) = jName            ' Отладочная печать имён файлов в директории

           On Error Resume Next
                Workbooks.Open Filename:=RabDir + "\" + jName    ' Открываем Exel файл
        
                If Err.Number = 0 Then
                    On Error GoTo 0
                    
                    For j = 0 To 2                              ' Забираем данные в массив
                        Mass(j) = Range("A1").Offset(j, 0)
                    Next
                 
    
                    Windows(SvodFileName).Activate
                    For j = 0 To 2                              ' Забираем данные из массива
                        Range("B1").Offset(i, j) = Mass(j)
                    Next
                    
                    Workbooks(jName).Close SaveChanges:=False   ' Закрываем книгу из которой брали данные
                End If
    

            i = i + 1
        End If
    Next

End Sub

Ответ отправил: Megaloman, Бакалавр
Ответ отправлен: 09.10.2009, 16:36

Оценка ответа: 5
Комментарий к оценке:
Спасибо большое, именно то что требовалось, не больше не меньше! Вся понятно, комментарии избыточны.

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255210 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Оценить выпуск »
Нам очень важно Ваше мнение об этом выпуске рассылки!

Задать вопрос экспертам этой рассылки »