Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск  
 
 
Рейтинг 4.83/35: Рейтинг темы: голосов - 35, средняя оценка - 4.83
16 / 4 / 0
Регистрация: 01.08.2011
Сообщений: 72

Организация циклической вставки данных

15.01.2013, 14:12. Показов 7881. Ответов 69
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Необходим макрос последовательного ввода данных в рабочую книгу из набора большого количества файлов, находящихся в 1 папке, например, с:\Baza и именуемые Файл1.xls, Файл2.xls и так далее. У всех у них один лист и называется одинаково "Лист1". Количество таких файлов конечно, но пока неизвестно. Необходимо последовательно в текущую открытую книгу на "Лист1" вставлять данные со столбца "А" по столбец "К" каждого из файлов последовательно, закрывая потом файл-источник. Возможно ли, чтобы макрос сам определял количество файлов-источников и формировал цикл? Процедура будет выполнятся многократно, поэтому нужен макрос. Процедуру обработки данных вставлю сам в нужное место.

Добавлено через 23 минуты
Забыл уточнить. Реализовать надо без использования буфера обмена.
0
Лучшие ответы (1)
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
15.01.2013, 14:12
Ответы с готовыми решениями:

Организация работы программ циклической структуры
Написать программу, которая вычисляет сумму первых n целых положительных четных чисел. Количество суммируемых чисел должно вводиться...

Организация работы программ циклической структуры
Написать программу, которая вычисляет факториал числа, введенного с клавиатуры. (Факториалом числа n называется произведение целых чисел ...

ОРГАНИЗАЦИЯ РАБОТЫ ПРОГРАММ ЦИКЛИЧЕСКОЙ СТРУКТУРЫ
Вычислить значения функции y = 4x 3 – 2x 2 + 5 для значений х, измeняющихся от –3 до 1, с шагом 0,1.

69
16 / 4 / 0
Регистрация: 01.08.2011
Сообщений: 72
16.01.2013, 13:03  [ТС]
Студворк — интернет-сервис помощи студентам
Все хорошо, но там, где в данных пустая ячейка, процедура,описанная в строках 31 и 32 рисует ноль. Можно избавиться от этого?
0
5472 / 1150 / 50
Регистрация: 15.09.2012
Сообщений: 3,578
16.01.2013, 13:05
Цитата Сообщение от San8691 Посмотреть сообщение
Все хорошо
быстрее работает код, чем с открытием книги и использованием команды Copy?


Цитата Сообщение от San8691 Посмотреть сообщение
процедура рисует ноль. Можно избавиться от этого?
в настройках программы Excel можно сделать так, чтобы нули не отображались на мониторе.
0
16 / 4 / 0
Регистрация: 01.08.2011
Сообщений: 72
16.01.2013, 13:21  [ТС]
код также немного подтормаживает, но быстрее, чем с открытием Тормозит одинаково не зависимо от размера данных, тогда как мелкие данные старая процедура хавает быстрее. Появление нулей в данных на месте пустых ячеек недопустимо, так как есть начальные данные со значением 0

Добавлено через 4 минуты
Казанский, Можно побороть появление нулей на месте пустых данных?
0
5472 / 1150 / 50
Регистрация: 15.09.2012
Сообщений: 3,578
16.01.2013, 13:25
Если я правильно понял, то в сообщении #37:
Организация циклической вставки данных

говорится об этом:
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Sub Procedure_1()
 
    'В константе "myPath" указываем путь папки, где находятся
        'книги Excel, из которых нужно взять данные.
    Const myPath As String = "C:\Users\User\Desktop\Папка"
    
    Dim shActiveSheet As Excel.Worksheet
    Dim myCurrentFile As String
    Dim myPreviousFile As String
    Dim myFlag As Boolean
    
    'Отключаем всё, что может тормозить работу кода.
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
 
    '1. Даём имя "shActiveSheet" активному листу. Через это имя
        'будем обращаться к активному листу.
    Set shActiveSheet = ActiveSheet
    
    '2. Для просмотра всех файлов в папке будем использовать
        'команду "Dir".
    
    '2.1. Помещаем в переменную "myCurrentFile" имя первого нужного файла.
    myCurrentFile = Dir(myPath & "\*.xlsm")
    
    '2.2. Делаем цикл до тех пор, пока в переменной "myCurrentFile"
        'будет имя файла. Файлы берутся в последовательности
        'по дате создания (нигде об этом не написано - узнали опытным путём).
    Do While myCurrentFile <> ""
        
        'Если обрабатываем первую книгу, то
            'на активном листе нет ещё формул.
        'Переменная "myFlag" используется, чтобы определять:
            'есть на листе формулы или нет.
        If myFlag = False Then
        
            '3. Помещаем на активный лист формулы.
            shActiveSheet.Range("A1:K1048576").FormulaArray = _
                "='" & myPath & "\[" & myCurrentFile & "]Лист1'!A1:K1048576"
        
        'Если в переменной "myFlag" содержится текст "True",
            'то на активном листе уже содержатся формулы и надо
            'только произвести замену в формулах.
        Else
        
            '4. Заменяю предыдущее имя файла в формулах на листе
                'на имя текущего файла.
            shActiveSheet.Columns("A:K").Replace _
                What:=myPreviousFile, Replacement:=myCurrentFile, _
                LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
                SearchFormat:=False, ReplaceFormat:=False
 
        End If
        
        '5. Здесь обработка данных в активной книге.
        'К активной книге нужно обращаться по имени "shActiveSheet".
        
        
        '6. Формулу помещаем только один раз, затем производим
            'в формуле замену имени одной книги на другое.
            'Поэтому делаем пометку.
        myFlag = True
        
        '7. Запоминаю имя предыдущего файла, чтобы его имя
            'заменить в формулах на листе Excel.
        myPreviousFile = myCurrentFile
        
        '8. Это взятие следующего имени файла с теми же
            'параметрами, что указаны в пункте 2.1.
        myCurrentFile = Dir
    
    Loop
    
    'Включаем то, что отключали.
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub

Я не дождался, когда произойдёт замена.

Если я всё делал правильно, то использование формул не подходит, когда используется много ячеек, т.к. код работает медленно. Остаются два варианта, как взять данные из закрытой книги:
  1. использование "ADO";
  2. использование функции VBA-Excel: ExecuteExcel4Macro.
0
15155 / 6428 / 1731
Регистрация: 24.09.2011
Сообщений: 9,999
16.01.2013, 13:25
Цитата Сообщение от Скрипт Посмотреть сообщение
Файлы берутся в последовательности по дате создания (но это нигде не написано - узнали опытным путём).
Что-то я этого не наблюдаю. Скорее, в алфавитном порядке. В любом случае, сначала можно получить список файлов на отдельном листе и отсортировать его по дате
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub bb()
Const PATH = "C:\Documents and Settings\USER\Мои Документы\Downloads\"
Dim s$, i&
s = Dir(PATH & "*.xlsm")
Cells.Clear
While s <> ""
    i = i + 1
    Cells(i, 1) = s
    Cells(i, 2) = FileDateTime(PATH & s)
    Cells(i, 3) = i 'только для иллюстрации - в каком порядке функция Dir выдает файлы
    s = Dir
Wend
Stop 'посмотрите на порядок файлов перед сортировкой по дате
     'нажмите F5
[b1].Sort [b1], xlAscending, Header:=xlNo
End Sub
2
16 / 4 / 0
Регистрация: 01.08.2011
Сообщений: 72
16.01.2013, 13:29  [ТС]
Казанский, С сортировкой, думаю разберусь. Подстроюсь под фактическую, если что. Ответьте про появление нулей на месте пустых ячеек после запроса в закрытую книгу. Кстати подвисание по времени сопоставимо что при процедуре открытия файла с миллионом записей, что при обращении в закрытую книгу
0
15155 / 6428 / 1731
Регистрация: 24.09.2011
Сообщений: 9,999
16.01.2013, 13:39
Цитата Сообщение от Скрипт Посмотреть сообщение
Если я правильно понял, то в сообщении #37 ... говорится об этом
Нееет! Я имел в виду расчетные формулы ТС, которые находятся на другом листе и для нас являются полной абстракцией. Как и данные.

Добавлено через 5 минут
Цитата Сообщение от San8691 Посмотреть сообщение
Можно побороть появление нулей на месте пустых данных?
Можно, но насколько это замедлит работу - судить не берусь: формула вместо =A1 должна быть =IF(A1="";"";A1)
1
16 / 4 / 0
Регистрация: 01.08.2011
Сообщений: 72
16.01.2013, 13:46  [ТС]
Короче, беру за основу сообщение #29, где происходит перенос данных с открытой книги, поскольку остальное по факту не приводит к повышению производительности. Но безусловно, забор данных из закрытой книги вещь полезная. Возможно применю в другом месте. Спасибо всем, что потратили время на помощь.
0
16.01.2013, 14:38
Лучший ответ Сообщение было отмечено как решение

Решение

Не по теме:

Цитата Сообщение от Скрипт Посмотреть сообщение
то в сообщении #37
Цитата Сообщение от San8691 Посмотреть сообщение
за основу сообщение #29
Неверный подход к указанию на сообщение!
Отображаемые номера сообщений могут по тем или иным причинам изменится,
да и искать их в многостраничных темах неудобно!
Правой кнопкой на номере нужного сообщения выбираем Копировать адрес ссылки и вставляем в пост:pardon:

3
5472 / 1150 / 50
Регистрация: 15.09.2012
Сообщений: 3,578
16.01.2013, 17:15
Пока прихожу к выводу, что Excel-команду ExecuteExcel4Macro можно применить только к одной ячейке.
Т.е. нужно использовать цикл, чтобы пройтись по всем ячейкам одиннадцати столбцов листа Excel.

Наверное, это будет тоже долго.

Остаётся тогда один вариант взятия данных из закрытой книги Excel: использование ADO.
0
6998 / 2896 / 555
Регистрация: 19.10.2012
Сообщений: 8,804
16.01.2013, 18:49
Вы ещё не рассмотрели вариант с GetObject() - это примерно как и WorkbooksOpen(), но без отображения окна файла.
Думаю должно быть побыстрее.
Т.е. примерно так (на примере кода Скрипта):

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
    Do While myFile <> ""
 
        '3. Открываем файл
        With GetObject(myPath & "\" & myFile).Worksheets(1)
 
            '4. Берём данные из файла и помещаем в активный лист.
            .Columns("A:K").Copy shActiveSheet.Range("A1")
 
            '5. Закрываем файл.
            .Parent.Close 0
        End With
 
        '6. Здесь обработка данных в активной книге.
        'К активной книге нужно обращаться по имени "shActiveSheet".
 
        '7. Это взятие следующего имени файла с теми же
        'параметрами, что указаны в пункте 2.1.
        myFile = Dir
 
    Loop
1
5472 / 1150 / 50
Регистрация: 15.09.2012
Сообщений: 3,578
16.01.2013, 19:17
Полный код с использование команды GetObject.
В данном случае книга Excel открывается, но не отображается на мониторе.

Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Sub Procedure_1()
 
    'В константе "myPath" указываем путь папки, где находятся
        'книги Excel, из которых нужно взять данные.
    Const myPath As String = "C:\Users\User\Desktop\Папка"
    
    Dim shActiveSheet As Excel.Worksheet
    Dim shSheet_1 As Excel.Worksheet
    Dim myFile As String
    
    'Отключаем всё, что может тормозить работу кода.
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
 
    '1. Даём имя "shActiveSheet" активному листу. Через это имя
        'будем обращаться к активному листу.
    Set shActiveSheet = ActiveSheet
    
    '2. Для просмотра всех файлов в папке будем использовать
        'команду "Dir" - может она будет обрабатывать файлы
        'в алфавитном порядке.
    
    '2.1. Помещаем в переменную "myFile" имя первого нужного файла.
    myFile = Dir(myPath & "\*.xlsm")
    
    '2.2. Делаем цикл до тех пор, пока в переменной "myFile"
    'будет имя файла.
    Do While myFile <> ""
 
        '3. Открываем файл и даём первому листу имя "shSheet_1".
        'Через это имя можно обращаться к листу.
        Set shSheet_1 = GetObject(PathName:=myPath & "\" & myFile).Worksheets(1)
 
        '4. Берём данные из файла и помещаем в активный лист.
        shSheet_1.Columns("A:K").Copy shActiveSheet.Range("A1")
 
        '5. Закрываем файл.
        shSheet_1.Parent.Close SaveChanges:=False
 
        '6. Здесь обработка данных в активной книге.
        'К активной книге нужно обращаться по имени "shActiveSheet".
        
        '7. Это взятие следующего имени файла с теми же
            'параметрами, что указаны в пункте 2.1.
        myFile = Dir
    
    Loop
    
    'Включаем то, что отключали.
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub



Примечание

Активная книга должна быть сохранена. Иначе при открытии файлов, активная книга закрывается.
1
16 / 4 / 0
Регистрация: 01.08.2011
Сообщений: 72
16.01.2013, 21:00  [ТС]
На рабочем компе все вроде шло ок, на домашнем ноуте ругается на строку 33. Библиотеку подключил. Один из файлов скопировал, встает на втором из списка, точнее на втором проходе по циклу
Миниатюры
Организация циклической вставки данных  
0
5472 / 1150 / 50
Регистрация: 15.09.2012
Сообщений: 3,578
16.01.2013, 21:02
San8691, активная книга должна быть сохранена. Если книга не сохранена, то она закрывается при открытии файла.
0
16 / 4 / 0
Регистрация: 01.08.2011
Сообщений: 72
16.01.2013, 21:18  [ТС]
Активная книга это та, в которой макрос (скрипт ) Конечно она сохранена. Или я чего-то не понимаю
0
5472 / 1150 / 50
Регистрация: 15.09.2012
Сообщений: 3,578
16.01.2013, 21:20
San8691, я под активной книгой понимаю в отношении вашей темы - книга, куда должны данные попадать и обрабатываться.


Цитата Сообщение от San8691 Посмотреть сообщение
макрос (скрипт )
в VBA нужно использовать слово макрос. Скрипт - это слово из других языков программирования.
0
16 / 4 / 0
Регистрация: 01.08.2011
Сообщений: 72
16.01.2013, 21:23  [ТС]
Это и есть та книга, где макрос находится. Или тут что-то не так? Копируется из файла-источника и вставляется в Лист1 файла, где макрос тут же и обработка будет
0
5472 / 1150 / 50
Регистрация: 15.09.2012
Сообщений: 3,578
16.01.2013, 21:24
San8691, не обращайте внимание на то, где находится макрос. Местоположение макроса не связано с тем, что он делает.
0
16 / 4 / 0
Регистрация: 01.08.2011
Сообщений: 72
16.01.2013, 21:30  [ТС]
33 строка - я создаю новый файл и обзываю лист на нем?? тогда ниже надо бы его сразу сохранить? каков тогда синтаксис? и почему нельзя все вставлять в файл, из которого был запущен макрос?
0
5472 / 1150 / 50
Регистрация: 15.09.2012
Сообщений: 3,578
16.01.2013, 21:34
San8691, вставьте ссылку на код, который вы используете.
Как сделать ссылку здесь написано:
https://www.cyberforum.ru/post4010026.html

Только в Internet Explorer 9 - Копировать ярлык.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
16.01.2013, 21:34

ОРГАНИЗАЦИЯ РАБОТЫ ПРОГРАММ ЦИКЛИЧЕСКОЙ СТРУКТУРЫ
В ЭВМ поступают результаты соревнований по плаванию для трех спортсменов. Выбрать и напечатать лучший результат. Решить задачу для ...

Организация работы программ циклической структуры
Сберегательная касса начисляет 2% годовых (т. е. через год вклад увеличивается на 2% без участия вкладчика). Какой станет сумма (в руб.),...

Макрос сбора и вставки данных
Здравствуйте! Помогите пожалуйста с задачей. В течение всего дня мне в отдельную папку (C:\test) скидывают файлы с таблицей EXCEL(в...

Универсальная функция вставки данных в БД
Добрый вечер! В базе данных находится множество таблиц с различной структурой (уникальный идентефикатор id имеется у всех таблиц)....

Ошибка вставки данных в бд access
Бд access. Соединение настроено, все компоненты на форме есть. Другие запросы выполняются. А этот нет. //Вставка значений в...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
60
Ответ Создать тему
Новые блоги и статьи
Мобильное приложение ColorStep
pavlinmavlin 17.09.2026
Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .
Запрет дублирования строк в табличной части
Maks 13.09.2026
Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр.
Jin X 06.09.2026
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .
Программа опроса у.з. расходомера SLS-720F
Argus19 02.09.2026
Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .
Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0.
Maks 31.08.2026
При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .
Архитектура биовида Стива в Майнкрафте: Зачем бонобо кубический каннибализм
anaschu 30.08.2026
Кубический Вагинокапитализм в Minecraft: Математический инвариант ОДУ и рок Стивов-бонобо Главная задача разработанной «Модели Всего» — наглядно продемонстрировать наличие системной «судьбы». . .
Оттачиваю умение писать js программы.
russiannick 30.08.2026
Проектом выходного дня стало написание Книги шифров Виженера. Итогом стала версия 200, синий туман. Синий туман назван так, потому что замораживает текст под собой. Нажатие синих кнопок управляют. . .
мат медиц модель 30. презентация проекта
anaschu 27.08.2026
хоп хоп хоп хидахоп, а я кладую))
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru