Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сбор данных из большого количества однотипных книг в одну, Сбор данных из большого количества однотипных книг в одну строку
 
#1
19.05.2020 10:08:26
Здравствуйте, помогите с задачей.
Есть более 300х файлов находящихся в одной папке, которые постоянно добавляются (имена файлов 001 ИП; 002 ИП; 003 ООО; 004 АО), имеющие одинаковую структуру, в них есть несколько листов, одни лист во всех называется "Данные". Вот из этого листа нужно вытащить несколько строк (не диапазон, а только конкретные) из одного столбца и перенести в отдельный файл. Должно получиться в первой строчке данные из первого файла, во второй из второго и т. д.. Желательно что бы обновлялось, т. е. задать папку с файлами.
Пробовал макрос, но он копирует только в столбцы.
Изменено: vologda - 19.05.2020 10:10:40
 
 
 
#2
19.05.2020 12:43:06
vologda, Добрый день, где в файле "Исходные данные" лист с именем "Данные". По какому принципу нужно вытаскивать оттуда данные? И по какому принципу они вставляются в файл "Итоговый журнал"?
 
 
 
#3
19.05.2020 13:05:10
msi2102, В прикрепленном файле "Исходные данные" только один лист из него нужно вытащить ячейки B1,B2,B3,B4,B5,B8,B12,B23,B24, и вставить в "Итоговый" другом файле в ячейке А1:I1.
Соответственно из последующих файлов должно встать в третью четвертую и т.д строки.
 
 
 
#4
19.05.2020 13:18:19
Управляться он откуда будет из Исходных данных или из Итогового файла?
 
 
 
#5
19.05.2020 13:22:02
Из Итогового. В идеале бы при открытии итогового файла что бы обновились данные.
 
 
 
#6
19.05.2020 14:10:00
В архиве файл для сбора данных "Итоговый журнал_3.xlsm" и в папке "База" четыре файла с данными. Нажмите кнопку и выберите эти файлы.
 
 
 
#7
19.05.2020 14:23:04
msi2102, спасибо большое. Все реализовалось.  
 
 
 
#8
30.07.2020 13:16:48
msi2102, просьба помочь отредактировать макрос.
Нужно поменять выборку под три отдельные ячейки.

Менял Range и Case. Но думаю я что то не так делаю в блоке Case'ов
Заранее благодарен.
Код
Sub Copy_data()
    Dim FilesToOpen
    Dim x As Integer
    Dim a(), i As Long, b As Long
    Dim lis As String
    
    Application.ScreenUpdating = False

 On Error GoTo EH
    
    FilesToOpen = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Select files to open"
        Exit Sub
    End If
    
    x = 1
    While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
        
        Workbooks(importWB.Name).Sheets("info").Activate
        a = Workbooks(importWB.Name).Sheets("info").Range("C6,C7,H5").Value

        b = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
        
        For i = 1 To 3
            Select Case i
                Case 1 To 3: s = i
            
            End Select
         
            ThisWorkbook.Sheets("Sheet1").Cells(b, i) = a(s, 1)
        
        Next

        importWB.Close savechanges:=False
        x = x + 1
    Wend

    Application.ScreenUpdating = True
    
    Exit Sub
    
EH:
    MsgBox "Info is copied"
    Application.ScreenUpdating = True
    
End Sub
Изменено: Easyway13 - 30.07.2020 13:18:16
 
 
 
#9
30.07.2020 13:38:36
Подозреваю, что в исходнике был непрерывный диапазон.
Код
a = Workbooks(importWB.Name).Sheets("info").Range("C6,C7,H5").Value

такая запись вернет только значение из С6
Нужно  формировать массив циклом.
 
 
 
#10
30.07.2020 14:14:03
Easyway13, попробуйте так:
Код
Sub Copy_data()
    Dim FilesToOpen
    Dim x As Integer
    Dim a(), i As Long, b As Long
    Dim lis As String
     
    Application.ScreenUpdating = False
 
 On Error GoTo EH
     
    FilesToOpen = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", MultiSelect:=True, Title:="Files to Merge")
 
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Select files to open"
        Exit Sub
    End If
     
    x = 1
    While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
         
        Workbooks(importWB.Name).Sheets("info").Activate
'        a = Workbooks(importWB.Name).Sheets("info").Range("C6,C7,H5").Value
 
        b = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
         
'        For i = 1 To 3
'            Select Case i
'                Case 1 To 3: s = i
             
'            End Select
          
            ThisWorkbook.Sheets("Sheet1").Cells(b, 1) = Workbooks(importWB.Name).Sheets("info").Range("C6").Value
            ThisWorkbook.Sheets("Sheet1").Cells(b, 2) = Workbooks(importWB.Name).Sheets("info").Range("C7").Value
            ThisWorkbook.Sheets("Sheet1").Cells(b, 3) = Workbooks(importWB.Name).Sheets("info").Range("H5").Value

         
'        Next
 
        importWB.Close savechanges:=False
        x = x + 1
    Wend
 
    Application.ScreenUpdating = True
     
    Exit Sub
     
EH:
    MsgBox "Info is copied"
    Application.ScreenUpdating = True
     
End Sub
но без файла для которого Вы делаете, это гадание на кофейной гуще
Изменено: msi2102 - 30.07.2020 14:19:53
 
 
 
#11
30.07.2020 14:32:09
RAN, если не сложно, можете помочь с циклом.
Крайне плохо знаком с VBA. До этого момента правил только макросы записаные через запись действий.

Буду крайне признателен за помощь.

P.S. Запрос не актуален, спасибо.
Изменено: Easyway13 - 30.07.2020 14:36:45
 
 
 
#12
30.07.2020 14:36:09
msi2102, у меня нет слов для выражения благодарности!
Огромное спасибо.
 
 
 
Страницы: 1
Наверх